pak BILLEDFIL som HEX - send til modtager som pakker ud og viser ....

prøv dette:
mvh mbs

---------------------------------------------------



unit Unit1;

interface

uses
  Windows, SysUtils, Classes, Controls, Forms, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    edFileName: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    butRead: TPanel;
    butWrite: TPanel;
    edTxtFile: TEdit;
    procedure butReadClick(Sender: TObject);
    procedure butWriteClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
NULL    = #0; //Blank char

//http://www.mortenbs.com/it/delphi/?example=plen
function pLen(p:pAnsiChar):longWord;
var p1:pAnsiChar;
begin
if p=nil then begin result:=0;exit end;
p1:=p;
while p^<>NULL do inc(p);
result:=p-p1
end;

//http://www.mortenbs.com/it/delphi/?example=pcopy
function pCopy(p:pAnsiChar;n:longWord):ansiString;
var rP:pAnsiChar;
begin
setLength(result,n);
rP:=pAnsiChar(result);
while n<>0 do begin
  rP^:=p^;
  inc(rP);
  inc(p);
  dec(n);
end;
end;

//NUMERIC CONVERSION

function uInt4ToHex(n:byte):ansiChar;
begin
case n of
  $0..$9:result:=ansiChar(n+48);
  $A..$F:result:=ansiChar(n+65-10);
else result:='0' end;
end;

function hexToUInt4(ch:ansiChar):byte;
begin
case ch of
  '0'..'9':result:=byte(ch)-48;
  'A'..'F':result:=byte(ch)-65+10;
  'a'..'f':result:=byte(ch)-97+10;
else result:=0 end;
end;

procedure p_uIntToHex(n:pByte;p:pAnsiChar;v:byte);
begin
inc(p,v*2-1);//last char
while v<>0 do begin
  p^:=uInt4ToHex(n^ and $F);dec(p);
  p^:=uInt4ToHex(n^ shr 4);dec(p);
  dec(v);inc(n);
end;
end;

//OTHER:

procedure pFill(p:pAnsiChar;sz:longWord;ch:ansiChar=NULL);
var eP:pAnsiChar;
begin
eP:=p+sz;
while p<>eP do begin p^:=ch;inc(p) end;
end;

//"safe" reallocate + fill blank
function pReAlloc(var p;sz:longWord;aZeroMem:boolean=true):boolean;
begin
try reAllocMem(pointer(p),sz);result:=true except result:=false end;
if result and aZeroMem then pFill(pointer(p),sz,NULL);
end;

function fileToMem(fileName:string;out p:pChar;out sz:longWord;aWantNull:boolean=false):boolean;
const BOOL_IO:array[boolean] of byte=(0,1);
var fs:TFileStream;n:longWord;
begin
result:=false;
p:=nil;
sz:=0;
try fs:=TFileStream.Create(fileName,fmOpenRead) except exit end;
sz:=fs.size;
if sz=0 then result:=true else try
  result:=pReAlloc(p,sz+BOOL_IO[aWantNull],false) and windows.readFile(fs.handle,p^,sz,n,nil);
  if result and aWantNull then (p+sz)^:=NULL;
except result:=false end;
fs.free;
if result then exit;
dispose(p);p:=nil;
sz:=0;
end;

function memToFile(aFileName:string;p:pChar;aSize:longWord):bool;
var fs:TFileStream;n:longWord;
begin
result:=false;
if aSize=0 then exit;
try fs:=TFileStream.Create(aFileName,fmCreate) except exit end;
if windows.writeFile(fs.handle,p^,aSize,n,nil) then result:=true;
fs.free;
end;


//HEX CODING

function p_hexEnc(p:pAnsiChar;n:longWord;var hP:pAnsiChar;out hL:longWord):boolean;
var rP,eP:pAnsiChar;
begin
result:=false;
if n=0 then exit;
hL:=n*2;
if not pReAlloc(hP,hL+1,false) then exit;
eP:=p+n;
rP:=hP;
while p<>eP do begin
  p_uIntToHex(@pByte(p)^,rP,1);
  inc(rP,2);
  inc(p);
end;
rP^:=#0;
result:=true;
end;

function p_hexDec(p:pAnsiChar;n:longWord;var hP:pAnsiChar;out hL:longWord):boolean;
var rP,eP:pAnsiChar;
begin
result:=false;
if (n=0) or (n mod 2<>0) then exit;
hL:=n div 2;
if not pReAlloc(hP,hL+1,false) then exit;
rP:=hP;
eP:=rP+hL;
while rP<>eP do begin
  pByte(rP)^:=hexToUInt4(pChar(p+1)^) or hexToUInt4(p^) shl 4;
  inc(p,2);
  inc(rP);
end;
rP^:=#0;
result:=true;
end;


//------------------------
//TForm1:

procedure TForm1.FormCreate(Sender: TObject);
begin
edFileName.text:='C:\image1.jpg';
edTxtFile.text:='C:\image1-hex.txt';
end;

procedure TForm1.butReadClick(Sender: TObject);
var
buf,buf2    :pAnsiChar;
sz,sz2      :longWord;
aFileName  :string;
aTxtFile    :string;
begin
aFileName:=edFileName.text;
aTxtFile:=edTxtFile.text;
if fileToMem(aFileName,buf,sz,true) then begin
  buf2:=nil;
  sz2:=0;
  if p_hexEnc(buf,sz,buf2,sz2) then begin
  memToFile(aTxtFile,buf2,sz2);
  dispose(buf2);
  end;
  dispose(buf);
end;
end;

procedure TForm1.butWriteClick(Sender: TObject);
var
buf,buf2    :pAnsiChar;
sz,sz2      :longWord;
aFileName  :string;
aTxtFile    :string;
begin
aFileName:=edFileName.text;
aTxtFile:=edTxtFile.text;
if fileToMem(aTxtFile,buf,sz) then begin
  buf2:=nil;
  sz2:=0;
  if p_hexDec(buf,sz,buf2,sz2) then begin
  memToFile(aFileName,buf2,sz2);
  dispose(buf2);
  end;
  dispose(buf);
end;
end;



end.

Der er også mulighed for at bruge base64 (MIME) udfra flere tegn, så fylder teksten mindre. Ved brug af HEX fordobles størrelsen (x2)

HEJ

Jeg har fundet en løsning.

Den er basert på delvist dit indlæg og noget jeg selv har strikket sammen.  Så drop et svar og du er rigere ( på point !)

KR

ok