COMPOSANT TLOG UTILISANT UNE DLL
Bacterius
Messages postés
3792
Date d'inscription
samedi 22 décembre 2007
Statut
Membre
Dernière intervention
3 juin 2016
-
12 mars 2009 à 20:01
Bacterius Messages postés 3792 Date d'inscription samedi 22 décembre 2007 Statut Membre Dernière intervention 3 juin 2016 - 15 mars 2009 à 15:48
Bacterius Messages postés 3792 Date d'inscription samedi 22 décembre 2007 Statut Membre Dernière intervention 3 juin 2016 - 15 mars 2009 à 15:48
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
https://codes-sources.commentcamarche.net/source/49479-composant-tlog-utilisant-une-dll
https://codes-sources.commentcamarche.net/source/49479-composant-tlog-utilisant-une-dll
15 mars 2009 à 15:48
- nouvelle unité LogLineFmtUtils, qui permet de formater une chaîne de caractères avec divers types dedans (pour l'instant, inclure une date, ou un entier sur 32 bits).
Cordialement, Bacterius !
14 mars 2009 à 11:53
Cordialement, Bacterius !
14 mars 2009 à 11:52
En tout cas ça marche :)
Cordialement, Bacterius !
12 mars 2009 à 21:12
Cordialement, Bacterius !
12 mars 2009 à 21:11
Je verrai tout ça demain, merci f0xi pour toutes ces nouvelles choses, je vais voir tout ça demain et faire refonctionner la source demain.
Cordialement, Bacterius !
12 mars 2009 à 21:07
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;
12 mars 2009 à 21:04
pour utiliser que le statique, il suffit d'enlever le . ici :
{.$DEFINE USEASSTATIC} ==> {$DEFINE USEASSTATIC}
le code en general :
il te faut etre plus discipliné dans l'indentation et les commentaires du code.
indentation : toujours un double espace exemple :
begin
bonjours;
for i := 0 to X do
AuRevoir;
end;
et pas :
begin
bonjours;
for
i := 0
to X do AuRevoir;
end;
explication :
if ... then. est une phrase on ne la casse pas
for to/downto do. egalement
begin ... end; est un bloc, begin se mets toujours en dessous d'une phrase au même niveau d'indentation.
if ... then
begin
end;
on place les commentaires de bloc ou de ligne au dessus de la declaration (sauf courte explication dans la declaration d'un type ou d'une classe)
Les commentaires s'indentent egalement.
on utilise // a la suite d'une ligne de code :
A := X + 1; // ma super formule
on utilise {} quand on est au dessus ou en dessous d'une ligne ou bloc de code
{ MaFonctionDeMaFormule
permet d'appliquer ma formule via ma fonction
parameters :
nom [I/O] type, description
X [I] integer, parametre X de ma formule
return :
type, description
notes : blablabla
}
function MaFonctionDeMaFormule(const X: integer): integer;
begin
result := X + 1; // c'est magique!
end;
note pour toi :
[I] = input --> le parametre est seulement lut
[O] = output --> le parametre est seulement modifié
[I/O] = input/output --> le parametre sera lut et modifié
regarde mes dernieres sources tu comprendra mieux.
n'oublis pas que le code et les commentaires doivent etre "aéré" pour une meilleure lisibilité.
l'indentation et les commentaires ne sont pas compilé a la fin et donc n'alourdissent pas le poids de l'application finale.
un code est fait pour être lus et compris, pas juste pour etre compilé!
n'oublie pas ce principe!
12 mars 2009 à 20:55
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 !
12 mars 2009 à 20:47
- modification pour l'utilisation Statique et Dynamique de la DLL
- correction pour l'emploi dynamique de la DLL
- renomage des fonctions de chargement/dechargement de la DLL (Load / Unload)!
- correction de la definition des valeurs des constantes d'erreurs (= emplois du code hexa)
- ajout des definition du type LOG_LINE version C/Delphi!
- refactoring de la source (presentation/nomage)
Composant :
- correction des declarations de fonctions
° const sur les parametres de types string
° var sur les parametres objets (TStringsList)
° correction de l'emploi tu type TStringList par TStrings
- refactoring de la source (presentation/nomage)
- correction des methodes de convertion String > Array of byte et inversement (A tester : non debogué)
- mise en conformité des emplois de BeginUpdate/EndUpdate de la classe TStrings (necessite un bloc Try...Finally!)
- suppression de la fermeture forcée du programme en cas de probleme de chargement de la DLL (n'est pas a lui de le faire!) > assertion d'une erreur (Fin de l'execution du code), la methode Destroy reste valide et pourra etre appelée a la fin normale du programme!
- Adaptation du composant pour l'utilisation de la DLL quelque soit son mode de chargement (Statique/Dynamique).
12 mars 2009 à 20:42
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 !
12 mars 2009 à 20:37
Bacterius
}
unit LogDLLIntf;
interface
{ Remove DOT from $DEFINE for use LogDLL in static mode }
{.$DEFINE USEASSTATIC}
uses Windows;
const
{ Errors result
}
UNTYPED_ERROR = $FFFFFFFF; // Untyped error
CLOSELOG_ERROR = $3E; // The CloseLog function failed
CLOSELOG_SUCCESS = $3F; // The CloseLog function has succeeded
READLOG_ERROR = $40; // The ReadLog function failed
READLOG_NO_LINES = $41; // The ReadLog function did not fail nor succeed because there were no lines to read
READLOG_NO_CALLBACK = $42; // The ReadLog function failed because no valid callback function was passed
READLOG_SUCCESS = $43; // The ReadLog function succeeded
WRITELOG_ERROR = $44; // The WriteLog function failed
WRITELOG_SUCCESS = $45; // The WriteLog function succeeded
CLEARLOG_ERROR = $46; // The ClearLog function failed
CLEARLOG_SUCCESS = $47; // The ClearLog function succeeded
LogLineArrayLength = 255; // The number of bytes in line array
type
{ LOG_LINE is the record that must be modified to change contents of a log }
LOG_LINE = record
lpText: array [0..LogLineArrayLength-1] of Byte;
end;
pLOG_LINE = ^LOG_LINE;
TLogLine = LOG_LINE;
pLogLine = pLOG_LINE;
const
{ The size, in bytes, of a LOG_LINE structure }
LogLineSize = SizeOf(LOG_LINE);
type
{ Callback function for ReadLog }
READLOG_CALLBACK = function(lpLine: LOG_LINE; lParam: Longword): BOOL; stdcall;
{$IFDEF USEASSTATIC}
function OpenLog(lpLogPath: PChar): HFILE; stdcall;
function CloseLog(dwFile: HFILE): Longword; stdcall;
function ReadLog(dwFile: Longword; lpCallback: Pointer; lParam: Longword): Longword; stdcall;
function WriteLog(dwFile: Longword; lpLine: LOG_LINE): Longword; stdcall;
function ClearLog(dwLog: Longword): Longword; stdcall;
const
UsesStaticDll = true;
{$ELSE}
var
OpenLog : function(lpLogPath: PChar): HFILE; stdcall;
CloseLog : function(dwFile: HFILE): Longword; stdcall;
ReadLog : function(dwFile: Longword; lpCallback: Pointer; lParam: Longword): Longword; stdcall;
WriteLog : function(dwFile: Longword; lpLine: LOG_LINE): Longword; stdcall;
ClearLog : function(dwLog: Longword): Longword; stdcall;
const
UsesStaticDll = false;
function LoadLogDLL(LogDLL: PChar): Boolean;
function UnloadLogDLL: Boolean;
{$ENDIF}
implementation
const
DefaultDLLName = 'LogDLL.dll';
{$IFDEF USEASSTATIC}
function OpenLog; external DLLNAME name 'OpenLog';
function CloseLog; external DLLNAME name 'CloseLog';
function ReadLog; external DLLNAME name 'ReadLog';
function WriteLog; external DLLNAME name 'WriteLog';
function ClearLog; external DLLNAME name 'ClearLog';
{$ELSE}
var
LogDLLHandle : HINST;
function LoadLogDLL(LogDLL: PChar): Boolean;
begin
result := false;
UnloadLogDLL;
if LogDLL = nil then
LogDLL := DefaultDLLName;
LogDLLHandle := LoadLibrary(LogDLL);
if LogDLLHandle = INVALID_HANDLE_VALUE then
Exit;
OpenLog := GetProcAddress(LogDLLHandle, 'OpenLog');
CloseLog := GetProcAddress(LogDLLHandle, 'CloseLog');
ReadLog := GetProcAddress(LogDLLHandle, 'ReadLog');
WriteLog := GetProcAddress(LogDLLHandle, 'WriteLog');
ClearLog := GetProcAddress(LogDLLHandle, 'ClearLog');
result := true;
end;
function UnloadLogDLL: Boolean;
begin
if LogDLLHandle <> INVALID_HANDLE_VALUE then
FreeLibrary(LogDLLHandle);
LogDLLHandle := INVALID_HANDLE_VALUE;
end;
{$ENDIF}
initialization
{$IFDEF USEASSTATIC}
{$ELSE}
LogDLLHandle := INVALID_HANDLE_VALUE;
{$ENDIF}
finalization
{$IFDEF USEASSTATIC}
{$ELSE}
UnloadLogDLL;
{$ENDIF}
end.
12 mars 2009 à 20:36
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.
12 mars 2009 à 20:01
Cordialement, Bacterius !