Bonjour,
Comment modifier une balise l := '<a href="http:\\www.xxx.sss" name="info">COM2015 © A 2015</a>';
par := l := '<a href="
http://www.zzz.fr " name="info">ZZZZ 2015 © A 2015</a>';
Cordialement
voici mon code:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, VirtualTrees, Buttons, JvExControls, JvNavigationPane,
ExtCtrls, AdvEdit, AdvEdBtn, AdvDirectoryEdit, StdCtrls, ImgList,StrUtils;
type
TLogType = (ltOk = 0, ltHint = 1, ltWarning = 2, ltError = 3, ltQuestion = 4);
PLogData = ^TLogData;
TLogData = record
LogType: TLogType;
Sender: WideString;
Date: TDateTime;
Time: TDateTime;
Description: WideString;
end;
TForm1 = class(TForm)
Panel6: TPanel;
JvNavPanelHeader7: TJvNavPanelHeader;
vtLog: TVirtualStringTree;
StatusBar1: TStatusBar;
GroupBox1: TGroupBox;
Timer1: TTimer;
Horloge: TTimer;
GroupBox2: TGroupBox;
Label10: TLabel;
Edit1: TEdit;
SpeedButton10: TSpeedButton;
SpeedButton9: TSpeedButton;
JvNavPanelHeader2: TJvNavPanelHeader;
ImageList1: TImageList;
SpeedBar: TPanel;
SpeedButtonPrint: TSpeedButton;
SpeedButtonPrinter: TSpeedButton;
ProgExport: TSpeedButton;
Info: TSpeedButton;
SpeedButton1: TSpeedButton;
procedure Timer1Timer(Sender: TObject);
procedure SpeedButton10Click(Sender: TObject);
procedure HorlogeTimer(Sender: TObject);
procedure SpeedButton9Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure vtLogBeforeCellPaint(Sender: TBaseVirtualTree;
TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
procedure vtLogGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode;
Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean;
var ImageIndex: Integer);
procedure vtLogGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
procedure vtLogInitNode(Sender: TBaseVirtualTree; ParentNode,
Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
procedure vtLogPaintText(Sender: TBaseVirtualTree;
const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType);
procedure SpeedButton1Click(Sender: TObject);
private
procedure AddLog(LogType: TLogType; Sender: WideString; Description: WideString);
public
{ Déclarations publiques }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
////////////////////////////////////////////////////////////////////////////////
// //
// Déscription : Fonction pour rechercher une balise html //
// //
////////////////////////////////////////////////////////////////////////////////
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;
function StripHTML(S: string): string;
var
TagBegin, TagEnd, TagLength: integer;
begin
TagBegin := Pos( '<', S); // search position of first <
while (TagBegin > 0) do begin // while there is a < in S
TagEnd := Pos('>', S); // find the matching >
TagLength := TagEnd - TagBegin + 1;
Delete(S, TagBegin, TagLength); // delete the tag
TagBegin:= Pos( '<', S); // search for next <
end;
Result := S; // give the result
end;
////////////////////////////////////////////////////////////////////////////////
// //
// Déscription : Procedure pour convertir un temp mm:ss en ms //
// //
////////////////////////////////////////////////////////////////////////////////
Procedure convert(tmps:TTimer; Etmps:string);
var
S : TEdit;
MinS : string; // Minute en caractère
SecS : string;
MinI : Integer; // Minute en entier
SecI : Integer;
MilSec : Integer; // Minute en millisecondes en entier
begin
//On transfert le string de Edit1.Text dans une variable S de type string
Etmps := S.Text;
//On sort de la variable S les minutes que l'on met dans une variable MinS de type string
MinS := Copy(Etmps, 0, Pos(':',Etmps)-1);
//On sort...
SecS := Copy(Etmps, Pos(':',Etmps)+1, Length(Etmps));
//On converti la variable MinS vers une variable MinL de type Integer (Entier)
MinI := StrToIntDef(MinS,0);
//Pour le calcul (Minutes * 60 + secondes) * 1000 a toi de faire la suite et les corrections
MilSec := (MinI * 60 + secI) * 1000;
//Transfert des Minutes en Millisecondes dans l'interval du timer
Tmps.Interval := MilSec;
//Transfert de l'entier des minutes transformé en milliseconde dans l'Edit2.Text en string pour te donner un exemple ...
Tmps.Enabled:=true;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
vtLog.NodeDataSize := SizeOf(tLogData);
AddLog(ltOk,'Démarrage','Lancement du programme.');
end;
procedure TForm1.HorlogeTimer(Sender: TObject);
begin
StatusBar1.Panels[1].Text:=TimeToStr(Now);
end;
procedure TForm1.SpeedButton10Click(Sender: TObject);
var
S : string;
MinS : string; // Minute en caractère
SecS : string;
MinI : Integer; // Minute en entier
SecI : Integer;
MilSec : Integer; // Minute en millisecondes en entier
begin
AddLog(ltWarning,'Modification','Début de la régénération dans : '+Edit1.Text+' min!');
//On transfert le string de Edit1.Text dans une variable S de type string
s := edit1.Text;
//On sort de la variable S les minutes que l'on met dans une variable MinS de type string
MinS := Copy(s, 0, Pos(':',s)-1);
//On sort...
SecS := Copy(s, Pos(':',s)+1, Length(s));
//On converti la variable MinS vers une variable MinL de type Integer (Entier)
MinI := StrToIntDef(MinS,0);
//Pour le calcul (Minutes * 60 + secondes) * 1000 a toi de faire la suite et les corrections
MilSec := (MinI * 60 + secI) * 1000;
//Transfert des Minutes en Millisecondes dans l'interval du timer
Timer1.Interval := MilSec;
//Transfert de l'entier des minutes transformé en milliseconde dans l'Edit2.Text en string pour te donner un exemple ...
Timer1.Enabled:=true;
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
Application.Terminate;
end;
procedure TForm1.SpeedButton9Click(Sender: TObject);
begin
Timer1.Enabled:=false;
AddLog(ltWarning,'Modification','Arrêt de la régénération!');
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
NewHTMLScript : TMemoryStream;
FStreamSrcHTML : TFileStream;
FStreamScrScript : TFileStream;
Buffer : array of AnsiChar;
PosSch,PosScht : Integer;
CRLF : AnsiString;
S,t,l : string;
FileSrcHTML : string;
FileSrcScript : string;
Balisea : string;
begin
// shape1.Brush.Color:=clPurple;
AddLog(ltOk,'Modification','Début de génération.');
StatusBar1.Panels[0].Text:='Début de génération.';
NewHTMLScript := TMemoryStream.Create;
try
FileSrcHTML := ExtractFilePath(Application.ExeName)+'index.html';//+'resultat.html';
FileSrcScript := ExtractFilePath(Application.ExeName)+'Script.html';//'c:\gec\script.html';
Balisea := t;//pour remplacer le site de Kramer
FStreamSrcHTML := TFileStream.Create(FileSrcHTML, fmOpenRead);
FStreamScrScript := TFileStream.Create(FileSrcScript, fmOpenRead);
try
SetLength(Buffer, FStreamSrcHTML.Size);
FStreamSrcHTML.ReadBuffer(Pointer(Buffer)^, Length(Buffer));
S := '</head>';
t := '<a href="http://www.sportsoftware.de" name="info">MT2003 © Stephan Krämer 2008</a>';
l := '<a href="http://www.eclems68.fr" name="info">COMRésult 2015 © ABONNEL Clément 2015</a>';
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);
t := StripHTML(l);
NewHTMLScript.SaveToFile(ExtractFilePath(Application.ExeName)+'Bis\index.html');
AddLog(ltHint,'Modification','Le fichierà été généré!');
end
else
AddLog(ltError ,'Modification',Format('La balise %s est introuvable dans le fichier :'#13#10' "%s"',[S, FileSrcHTML]));
// 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;
procedure TForm1.vtLogBeforeCellPaint(Sender: TBaseVirtualTree;
TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
begin
if (Integer(Node.Index) mod 2) = 1 then
begin
TargetCanvas.Brush.Color := $00F7F7F7;
TargetCanvas.FillRect(CellRect);
end;
end;
procedure TForm1.vtLogGetImageIndex(Sender: TBaseVirtualTree;
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
var Ghosted: Boolean; var ImageIndex: Integer);
var
Data: PLogData;
begin
Data := Sender.GetNodeData(Node);
if Assigned(Data) then
case Column of
-1, 0: ImageIndex := Integer(Data^.LogType);
end;
end;
procedure TForm1.vtLogGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
var
Data: PLogData;
begin
Data := Sender.GetNodeData(Node);
if Assigned(Data) then
case Column of
-1,
0: CellText := ' ';
1: CellText := Data^.Sender;
2: CellText := DateToStr(Data^.Date)+' '+TimeToStr(Data^.Time);
3: CellText := Data^.Description;
end;
end;
procedure TForm1.vtLogInitNode(Sender: TBaseVirtualTree; ParentNode,
Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
begin
// vtLog.NodeHeight[Node] := 40;
Include(InitialStates, ivsMultiline);
end;
procedure TForm1.vtLogPaintText(Sender: TBaseVirtualTree;
const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType);
begin
// fix winXP style
if (vsSelected in Node.States) then
TargetCanvas.Font.Color := clBlack;
end;
procedure Tform1.AddLog(LogType: TLogType; Sender: WideString; Description: WideString);
var
Node: PVirtualNode;
Data: PLogData;
begin
vtLog.BeginUpdate;
Node := vtLog.AddChild(vtLog.RootNode);
Data := vtLog.GetNodeData(Node);
Data^.LogType := LogType;
Data^.Sender := Sender;
Data^.Date := Date;
Data^.Time := now;
Data^.Description := Description;
vtLog.EndUpdate;
end;
end.
BeepBepp68
Edit: ajout de balise de code (Cirec)
Afficher la suite