11. december 2013 - 09:26 Der er 3 kommentarer og
1 løsning

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

HEJ,

Har følgende problem (opgave):

Jeg skal gemme et billede (Timage) format (Jpg, BMP, PNG, GIF ... what-ever) i en database i forbindelse med en HTML-string. (Det er på en måde en lokal modificeret MHTML string).  Dette fordi min Twebbrowser ikke supporterer MHT-stream's. )

(Data og billeder er medicinske data, så der er en vis "hemmelighedskræmmeri " omkring disse HTML-data (med billeder).

Også ud fra betragtningen: AT delphi har regnekraften og HTML har præsentationen .! )

Min "MHT-generator" genererer kun delvis ægte MHT -filer. Links til billeder er som <img src="billedfil" ... osv) hvor ægte MHT-filer danner en inline hex-string, som skal konverteres (via BAse64) til det respektive billede.

Det jeg har brug for er en IMAGE_to_HEX rutine, som kan omdanne en billedfil til den ækvivalente HEX-fil. Altså fra det binære til det HEXAdecimale format.

Og tilsvarende den anden vej. Fra HEX- til bin. HEX_TO_IMAGE..

Styring af filer og billeder sker via et hidden't bibliotek, som oprettes og slettes ved start af program og ved afslutning.

Jeg har eksperimenteret lidt men det fylder alt for meget og er aller helhest u-elegant. Not the Delphi way.

Assignfile(...);  REsetFile(); --  og den slags. Læs en byte / char af gangen, omdan til HEX - gem igen... Sløvt og u-moderne.

Er på jagt efter en STREAM -løsning, så det kan "gøres i et hug".

Har ikke fundet noget anvendeligt på nettet.

KRISTIAN
Avatar billede mbsnet Nybegynder
12. december 2013 - 22:23 #1
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.
Avatar billede mbsnet Nybegynder
12. december 2013 - 22:27 #2
Der er også mulighed for at bruge base64 (MIME) udfra flere tegn, så fylder teksten mindre. Ved brug af HEX fordobles størrelsen (x2)
10. januar 2014 - 11:43 #3
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
Avatar billede mbsnet Nybegynder
10. januar 2014 - 20:44 #4
ok
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Kurser inden for grundlæggende programmering

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester