Так ‰png != ‰PNG
| Код |
function binpos(p:pointer;substr:pchar;length:cardinal):pointer;
var i,j,l:cardinal;
begin
i:=0;
l:=strlen(substr);
length:=length-l;
result:=nil;
while i<=length do
begin
for j:=0 to l-1 do
if pchar(cardinal(p)+i+j)^<>(substr+j)^ then break;
if j=l then
begin
result:=pointer(cardinal(p)+i);
break;
end;
inc(i);
end
end;
procedure TForm1.Button1Click(Sender: TObject);
var
h1,h2,fs:cardinal;
p1,p2:pointer;
begin
if not opendialog1.Execute or not savedialog1.Execute then exit;
h1:=fileopen(opendialog1.FileName,0);
fs:=getfilesize(h1,nil);
getmem(p1,fs);
fileread(h1,p1^,fs);
p2:=binpos(p1,'‰PNG',fs);
if p2<> nil then
begin
h2:=filecreate(savedialog1.FileName);
filewrite(h2,p2^,fs-(cardinal(p2)-cardinal(p1)));
fileclose(h2);
end;
freemem(p1);
fileclose(h1);
end;
|
|