Salut,
désolé il y a plus simple mais j'ai ceci sous la main et copier coller avec quelques modif c'est rapide :p
procedure TForm1.Button1Click(Sender: TObject);
var
NewHTMLScript : TMemoryStream;
FStreamSrcHTML : TFileStream;
FStreamScrScript : TFileStream;
Buffer : array of AnsiChar;
PosSch : Integer;
CRLF : AnsiString;
S : string;
FileSrcHTML : string;
FileSrcScript : string;
function SearchBal(const S, Src: string): Integer;
var
LnS : Integer;
LnSrc : Integer;
I, J : Integer;
PS : PChar;
PSrc : PChar;
FindStr : Boolean;
begin
Result := -1;
LnS := Length(S);
LnSrc := Length(Src);
PS := PChar(S);
PSrc := PChar(Src);
I := 0;
while I < LnSrc do
begin
if PSrc^ = PS^ then
begin
FindStr := True;
J := 0;
while J < LnS do
begin
if PSrc^ <> PS^ then
begin
FindStr := False;
Break;
end;
Inc(PSrc);
Inc(PS);
Inc(I);
Inc(J);
end;
PS := @S[1];
if FindStr then
begin
Result := I;
Break;
end;
end
else
begin
Inc(PSrc);
Inc(I);
end;
end;
end;
begin
NewHTMLScript := TMemoryStream.Create;
try
FileSrcHTML := ExtractFilePath(Application.ExeName)+'HTML Source.html';
FileSrcScript := ExtractFilePath(Application.ExeName)+'HTML Script.html';
FStreamSrcHTML := TFileStream.Create(FileSrcHTML, fmOpenRead);
FStreamScrScript := TFileStream.Create(FileSrcScript, fmOpenRead);
try
SetLength(Buffer, FStreamSrcHTML.Size);
FStreamSrcHTML.ReadBuffer(Pointer(Buffer)^, Length(Buffer));
S := '</head>';
PosSch := SearchBal(S, PAnsiChar(Buffer));
if PosSch <> -1 then
begin
NewHTMLScript.Write(Buffer[0], FStreamSrcHTML.Size);
NewHTMLScript.Seek(PosSch, 0);
FStreamSrcHTML.Seek(PosSch, 0);
CRLF := #13#10;
NewHTMLScript.Write(PChar(CRLF)^, Length(CRLF));
NewHTMLScript.CopyFrom(FStreamScrScript, FStreamScrScript.Size);
NewHTMLScript.CopyFrom(FStreamSrcHTML, FStreamSrcHTML.Size - PosSch);
NewHTMLScript.SaveToFile(ExtractFilePath(Application.ExeName)+'HTML Source + Script.html');
end
else
MessageDlg(Format('La balise %s est introuvable dans le fichier :'#13#10'"%s"',[S, FileSrcHTML]), mtError, [mbOK], 0);
finally
FStreamSrcHTML.Free;
FStreamScrScript.Free;
end;
finally
NewHTMLScript.Free;
end;
end;
@+
26 févr. 2015 à 11:50
merci encore