Sujet Précédent Sujet Suivant

Modifier balise

BeepBepp68 - Modifié par Cirec le 18/04/2015 à 16:56
dubois77 Messages postés 675 Date d'inscription jeudi 17 avril 2008 Statut Membre Dernière intervention 19 février 2019 - 21 avril 2015 à 08:56
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)

2 réponses

Réponse 1 / 2
Whismeril Messages postés 19035 Date d'inscription mardi 11 mars 2003 Statut Contributeur Dernière intervention 1 mai 2024 656
18 avril 2015 à 18:28
Bonjour, je ne fais pas de delphi. Cependant la regex est un outil recherche et ou remplacement de texte.
http://delphi.developpez.com/faq/?page=Expressions-regulieres
0
Réponse 2 / 2
dubois77 Messages postés 675 Date d'inscription jeudi 17 avril 2008 Statut Membre Dernière intervention 19 février 2019 14
21 avril 2015 à 08:56
Salut
Je ne vois pas trop le rapport entre la question posée et tout le code affiché !
Dans la question il s'agit de remplacer des "\" par des "/" et "COMM2015" par "ZZZZ 2015"
pour les // un ansireplace devrait faire l'affaire et pour le ZZZZ un pos(....) également
mais je n'ai peut être pas tout compris
Précise ce que tu veux faire exactement et quand dans ton code
Cordialement
0

Discussions similaires

Fermer les balises html en fin de requete
cs_badben -
Dahevos -

8 réponses
où trouver toutes les balises PHP et leurs fonctions??
alex -
alex -

7 réponses
conception de systéme de géolocalisation de véhicule par balise gps
goa98341 -
goa98341 -

2 réponses
Pb avec balise system et wget
ludovicanceaux -
ludovicanceaux -

11 réponses
Balises ouvrantes et fermantes php
Cyru_s -
malalam -

11 réponses
Rejoignez-nous