COMPOSANT TLOG UTILISANT UNE DLL

Commentaire de f0xi le 12/03/2009 20:36:57 administrateur CS

{

Composant utilisant la DLL LogDLL.dll.
Auteur : Bacterius
Conseil du jour : pensez à séparer la ligne de 255 caractères du log en plusieurs
sous-chaînes de 64 caractères par exemple, comme ça vous pourrez enregistrer
plusieurs informations dedans. Vous pouvez également utiliser 2 à 4 caractères d'une
ligne pour faire des nombres (mots de poids faible, fort, etc ...).
C'est fou tout ce qu'on peut mettre dans une chaîne de 255 caractères !!

}

unit LogComponent;

interface

uses                                      
  Windows, Messages, SysUtils, Classes, Forms, Dialogs,
  LogDLLIntf; // Je vous engage à aller voir LogDLLIntf !

type
{ TLog }
  TLog = class(TComponent)
  private
    FStringList : TStringList;                    // La liste qui contiendra nos chaînes
    FLoaded     : Boolean;                        // Si l'interface DLL a chargé la DLL
    FOpened     : Boolean;                        // Si un log est actuellement ouvert
    FPath       : String;                         // Le path du log
    FHandle     : HFILE;                          // Le handle du fichier log
    FOnOpen     : TNotifyEvent;                   // Evenement OnOpen
    FOnClose    : TNotifyEvent;                   // Evenement OnClose
    FOnChange   : TNotifyEvent;                   // Evenement OnChange
    function IsRuntime: Boolean;                  // Détermine si l'on est en mode conception (false) ou runtime (true)
    procedure SetPath(const Value: String);       // Setter FPath
    function GetLine(Index: Integer): String;     // Getter propriété tableau Lines
    function GetCount: Integer;                   // Getter propriété Count
  protected
    procedure UpdateStringList;                   // Met à jour la liste qui contient nos chaînes
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;                    
    procedure AddLine(const ALine: String);              // Ajout d'une ligne dans le log
    procedure Clear;                                     // Vidage du log
    procedure Close;                                     // Fermeture du fichier log
    procedure LogToStringsList(List: TStrings);          // Remplit une liste avec les chaînes du log
    property Lines[Index: Integer]: String read GetLine; // Acces à chaque ligne du log
  published
    property Path    : String       read FPath     write SetPath;
    property Count   : Integer      read GetCount;                
    property Opened  : Boolean      read FOpened;
    property OnOpen  : TNotifyEvent read FOnOpen   write FOnOpen;
    property OnClose : TNotifyEvent read FOnClose  write FOnClose;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

procedure Register;

implementation

var
TempList: TStringList; // Liste temporaire pour le callback

procedure Register;
begin
  RegisterComponents('Bacterius', [TLog]);
end;

function TLog.IsRuntime: Boolean;
begin
  Result := not (csDesigning in ComponentState);
end;

constructor TLog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  // On crée la liste des chaînes
  FStringList := TStringList.Create;

  // Handle du fichier à 0
  FHandle := 0;
  
  // Si on est en runtime
  if IsRuntime then
  begin
    { On tente d'initialiser notre interface DLL

      CHECK DEFINITION OF USEASSTATIC IN LogDLLIntf
    }
    {$IF UsesStaticDll}
    FLoaded := true;
    {$ELSE}
    FLoaded := LoadLOGDLL(nil);
    {$IFEND}
    // Si on a échoué à l'initialiser ...
    assert(FLoaded, 'La DLL "LogDLL.dll" est introuvable.');
  end;
end;

destructor TLog.Destroy;
begin
// Si on est en runtime, alors on libère ce qu'on doit libérer
if IsRuntime then
begin
   // On ferme le fichier log si il est ouvert
   if FOpened then
     CloseLog(FHandle);
    
   // On finalise l'interface DLL si nécessaire
   if FLoaded then
     UnloadLogDLL;
  end;

// On libère la liste
FStringList.Free;

inherited Destroy;
end;

procedure TLog.SetPath(Value: String);
begin
if Value <> FPath then // Si on change de log
begin
   // Si on est pas en runtime, on s'arrête là
   if not IsRuntime then
     Exit;
    
   // On charge le log
   FHandle := OpenLog(PChar(Value));

   // Si erreur de chargement
   if FHandle = HFILE_ERROR then
   begin
     FOpened := False; // On met à false la propriété Opened
     FPath   := '';    // On vide le Path
     FHandle := 0;     // Idem avec le handle

     // On balance une méchante exception
     raise Exception.Create('Impossible d''ouvrir ce log : il est peut-être utilisé par un autre processus.');
   end;

   // Si on est arrivé là, c'est que tout s'est bien passé
   FPath   := Value; // On change la propriété Path
   FOpened := True;  // On met Opened à True (il est ouvert !)
   if Assigned(FOnOpen) then
     FOnOpen(self); // On lance OnOpen si il y a un truc dedans
  end;
end;

// Callback générique pour lire le log
function ReadCallback(lpLine: LOG_LINE; lParam: Longword): BOOL; stdcall;
Var
I: Integer;
S: String;
pB: ^byte;
begin
  // Ici, on convertit l'array of Byte du log en String
  SetLength(S, LogLineArrayLength);
  pB := @S[1];
  for I := 0 to LogLineArrayLength-1 do
  begin
    pB^ := pLine.lpText[I];
    inc(pB);
    if pB^ = 0 then
    break;
  end;

  // On ajoute dans la liste temporaire
  TempList.Add(S);

  // On continue la lecture de la liste
  Result := True;  
end;

procedure TLog.UpdateStringList; // Met à jour la liste des chaînes du log
begin
  // Si aucun log ouvert, on s'arrête là
  if not FOpened then
    Exit;

  // On crée la liste temporaire
  TempList := TStringList.Create;
  try
    // Debut de la mise a jour
    FStringList.BeginUpdate;
    try
      // On vide la liste des chaînes
      FStringList.Clear;

      // On lance la lecture du log (voir callback plus haut)
      ReadLog(FHandle, @ReadCallback, 0);

      // A la fin de la lecture, on copie toutes les chaînes lues
      FStringList.AddStrings(TempList);
    finally  
      // Fin de la mise à jour
      FStringList.EndUpdate;
    end;
  finally
    // On libère la liste temporaire
    TempList.Free;
  end;
end;

function TLog.GetLine(Index: Integer): String;  // Récupère une ligne du log
begin
  // On va chercher la ligne dans le TStringList
  if FOpened and (Index < GetCount) then
  begin
    // On met à jour les chaînes
    UpdateStringList;
    Result := FStringList.Strings[Index];
  end;
end;

procedure TLog.AddLine(const ALine: String); // On ajoute une ligne dans le log
Var
pB : ^byte;
I, L: Integer;
Ln: LOG_LINE;
begin
  if (not FOpened) or (ALine = EmptyStr) then
    Exit;

  pB := @ALine[1];  
  L  := Length(ALine);
  // On initialise (c'est mieux parce que sinon la lecture peut être bizarre)
  for I := 0 to LogLineArrayLength-1 do
    Ln.lpText[I] := 0;

  // On tronque la chaîne si nécessaire, et on convertit en array of byte
  if L > LogLineArrayLength then
    for I := 0 to LogLineArrayLength-1 do
    begin
      Ln.lpText[I] := pB^;
      inc(pB);
    end
  else
    for I := 0 to L do
    begin
      Ln.lpText[I] := pB^;
      inc(pB);
    end;  

  // On écrit la ligne dans le log
  WriteLog(FHandle, Ln);
  
  // On lance OnChange si on a quelque chose
  if Assigned(FOnChange) then
    FOnChange(self);
end;

procedure TLog.Clear; // Vidage du log
begin
  // Si un log est ouvert
  if FOpened then
  begin
    // On vide ce log
    ClearLog(FHandle);

    // On lance OnChange si on a quelque chose
    if Assigned(FOnChange) then
      FOnChange(self);
  end;
end;

procedure TLog.Close; // Fermeture du fichier log
begin
  // Si un log est ouvert
  if FOpened then
  begin
    // On ferme ce log
    CloseLog(FHandle);
    
    // On remet toutes ces propriétés aux valeurs par defaut
    FHandle := 0;
    FOpened := False;
    FPath := '';
    
    // On lance OnClose si on a quelque chose
    if Assigned(FOnClose) then
      FOnClose(self);
  end;
end;

function TLog.GetCount: Integer; // Récupère le nombre de lignes dans le log
begin
  Result := 0;
  if FOpened then
    Result := GetFileSize(FHandle, nil) div LogLineArrayLength; // Taille du fichier / taille d'une ligne ...
end;

procedure TLog.LogToStringsList(List: TStrings); // Copie notre liste de chaînes dans une liste tierce
begin
  // Si on a un log et que List est assigné
  if FOpened and (Assigned(List)) then
  begin
    // On met à jour notre liste
    UpdateStringList;
    // On debute la mise a jour
    List.BeginUpdate;
    try
      // On vide sa liste
      List.Clear;
      // On copie notre liste dans la sienne
      List.AddStrings(FStringList);
    finally
      // On arrete la mise a jour
      List.EndUpdate;
    end;
  end;
end;

end.

Commentaire de Bacterius le 12/03/2009 20:42:38

@f0xi : ok pour l'interface de la DLL, je vais arranger tout ça et comprendre.
Mais pourquoi veux-tu faire 2 modes pour le chargement de la DLL ? Je veux dire, le statique est beaucoup mieux pour le composant, sinon Delphi risque de planter souvent au démarrage si l'on a installé le composant.
Je vais regarder tout ça.
Sinon que penses-tu du code en général ?

Cordialement, Bacterius !

Commentaire de Bacterius le 12/03/2009 20:55:38

Ok, je mets tout ça à jour tout de suite.
Je n'avais pas pensé à ça pour l'arrêt du constructeur en cas de problème de chargement.
Mais je ne comprends pas ça : "ajout des definition du type LOG_LINE version C/Delphi!" ?

Cordialement, Bacterius !

Commentaire de f0xi le 12/03/2009 21:07:42 administrateur CS

UNE_DECLARATION  = pur style C
TUneDeclaration = pur style Delphi
uneDeclaration = pur style action script
uNe_DeCLaRaTioN = pur style n'importe quoi ... :)

en gros on peu ecrire les choses comme ça :

{$SYMEXTERNAL MA_DECLARATION}
MA_DECLARATION = record
  ...
end;
TMaDeclaration = MA_DECLARATION;

Commentaire de Bacterius le 12/03/2009 21:12:24

Ok pour tes 2 derniers commentaires f0xi. Je vais lire ça attentivement c'est interessant je trouve.

Cordialement, Bacterius !

Commentaire de Bacterius le 14/03/2009 11:53:16

En revanche je n'ai pas encore modifié tous les commentaires, mis en forme et tout, j'ai déjà réparé le fonctionnement, je m'occupe de la mise en page dans peu de temps.

Cordialement, Bacterius !