From 1fe82b862ac670b6ef619966aa12fcfd536ff3f1 Mon Sep 17 00:00:00 2001 From: Artem3213212 Date: Mon, 28 May 2018 15:56:36 +0300 Subject: [PATCH] Final Delphi+part of FPC --- AG.Logs.pas | 146 ++++++++++++++++++++++-------------- FPCTest/fpcunitproject1.lpi | 76 +++++++++++++++++++ FPCTest/fpcunitproject1.lpr | 25 ++++++ FPCTest/fpcunitproject1.lps | 90 ++++++++++++++++++++++ FPCTest/testcase1.pas | 53 +++++++++++++ Tests/Unit2.pas | 12 ++- 6 files changed, 341 insertions(+), 61 deletions(-) create mode 100644 FPCTest/fpcunitproject1.lpi create mode 100644 FPCTest/fpcunitproject1.lpr create mode 100644 FPCTest/fpcunitproject1.lps create mode 100644 FPCTest/testcase1.pas diff --git a/AG.Logs.pas b/AG.Logs.pas index a06d0b4..5e56b8b 100644 --- a/AG.Logs.pas +++ b/AG.Logs.pas @@ -2,31 +2,31 @@ unit AG.Logs; interface -//{$UNDEF MSWINDOWS} - uses {$IFDEF MSWINDOWS}{$IFDEF FPC}Windows{$ELSE}Winapi.Windows{$ENDIF},{$ENDIF} - {$IFDEF FPC}FGL{$ELSE}System.Generics.Collections,{$ENDIF} - {$IFDEF FPC}System.SysUtils{$ELSE}SysUtils{$ENDIF}, - {$IFDEF FPC}System.Classes{$ELSE}Classes{$ENDIF}, - {$IFDEF FPC}System.DateUtils{$ELSE}DateUtils{$ENDIF}, - {$IFDEF FPC}System.SyncObjs{$ELSE}SyncObjs{$ENDIF}; + {$IFDEF FPC}FGL{$ELSE}System.Generics.Collections{$ENDIF}, + {$IFDEF FPC}SysUtils{$ELSE}System.SysUtils{$ENDIF}, + {$IFDEF FPC}Classes{$ELSE}System.Classes{$ENDIF}, + {$IFDEF FPC}DateUtils{$ELSE}System.DateUtils{$ENDIF}, + {$IFDEF FPC}SyncObjs{$ELSE}System.SyncObjs{$ENDIF} + {$IFNDEF MSWINDOWS}, + {$IFNDEF FPC}System.IOUtils{$ENDIF} + {$ENDIF}; type TAGLog=class abstract strict protected tabs:cardinal; - tabstr:widestring; + tabstr:string; constructor Create(); const CBaseTab='--------------------------'; public - class function SisebleWordtoStr(i:word;size:int8):widestring;static;inline; - class function GenerateLogString(s:widestring;o:TObject=nil):widestring;static;inline; + class function SisebleWordtoStr(i:word;size:int8):string;static;inline; + class function GenerateLogString(s:string;o:TObject=nil):string;static;inline; procedure Tab();virtual; procedure UnTab();virtual; - procedure Write(Text:WideString;o:TObject=nil);overload;virtual;abstract; - procedure Write(const data);overload;virtual;abstract; + procedure Write(Text:string;o:TObject=nil);overload;virtual;abstract; destructor Destroy();override; end; @@ -34,28 +34,34 @@ type public buf:WideString; constructor Create();overload; - procedure Write(Text:WideString;o:TObject=nil);overload;override; + procedure Write(Text:string;o:TObject=nil);overload;override; end; TAGDiskLog=class(TAGLog) strict protected - LogHandle,ThreadHandle:NativeUInt; - ThreadID:cardinal; + {$IFNDEF MSWINDOWS} + Stream:TStream; + {$ELSE} buf1:WideString; onbuf:boolean; + LogHandle,ThreadHandle:NativeUInt; + ThreadID:cardinal; Lock:TCriticalSection; WantTerminate:Boolean; + {$ENDIF} public constructor Create(FileName:WideString);overload; - procedure Init();{override;}stdcall; - procedure Write(Text:WideString;o:TObject=nil);overload;override; + {$IFDEF MSWINDOWS} + procedure Init();stdcall; + {$ENDIF} + procedure Write(Text:string;o:TObject=nil);overload;override; destructor Destroy();overload;override; end; TAGNullLog=class(TAGLog) public constructor Create();overload; - procedure Write(Text:WideString;o:TObject=nil);overload;override; + procedure Write(Text:string;o:TObject=nil);overload;override; end; {$IFDEF MSWINDOWS} @@ -64,7 +70,7 @@ type CommandLine:THandle; public constructor Create(Handele:THandle);overload; - procedure Write(Text:WideString;o:TObject=nil);overload;override; + procedure Write(Text:string;o:TObject=nil);overload;override; destructor Destroy();overload;override; end; {$ENDIF} @@ -73,46 +79,43 @@ type strict protected stream:TStream; public - constructor Create(stream:TStream);overload; - procedure Write(Text:WideString;o:TObject=nil);overload;override; + constructor Create(Astream:TStream);overload; + procedure Write(Text:string;o:TObject=nil);overload;override; end; TAGCallBackLog=class(TAGLog) strict protected type - TCallBack=procedure(s:string); + TCallBack={$IFNDEF FPC}reference to{$ENDIF}procedure(s:string); var CallBack:TCallBack; public - constructor Create(CallBack:TCallBack);overload; - procedure Write(Text:WideString;o:TObject=nil);overload;override; + constructor Create(ACallBack:TCallBack);overload; + procedure Write(Text:string;o:TObject=nil);overload;override; end; TAGMultiLog=class(TAGLog) public type - TLogsList=TList; + TLogsList={$IFDEF FPC}specialize TFPGList{$ELSE}TList{$ENDIF}; var Logs:TLogsList; constructor Create(Default:TLogsList);overload; - procedure Write(Text:WideString;o:TObject=nil);overload;override; + procedure Write(Text:string;o:TObject=nil);overload;override; procedure Tab();override; procedure UnTab();override; destructor Destroy();overload;override; end; - -const - SisebleWordtoStr:function(i:word;size:int8):widestring=TAGLog.SisebleWordtoStr; Implementation constructor TAGLog.Create(); begin -Self.Write(sLineBreak+CBaseTab+'Logging init'+CBaseTab+sLineBreak); -end; +Self.Write(CBaseTab+'Logging init-'+CBaseTab); +end; -class function TAGLog.SisebleWordtoStr(i:word;size:int8):widestring; +class function TAGLog.SisebleWordtoStr(i:word;size:int8):string; begin - Result:=inttostr(i); + Result:=IntToStr(i); size:=size-Length(Result); case size of 0:Result:=Result; @@ -123,19 +126,23 @@ begin end; end; -class function TAGLog.GenerateLogString(s:widestring;o:TObject=nil):widestring; +class function TAGLog.GenerateLogString(s:string;o:TObject=nil):string; var D:TDateTime; begin D:=Time; if o<>nil then - Result:=o.QualifiedClassName+'['+IntToStr(o.GetHashCode)+']:' + {$IFDEF FPC} + Result:=o.ClassName+'['+IntToStr(o.GetHashCode)+']:' + {$ELSE} + Result:=o.QualifiedClassName+'['+IntToStr(o.GetHashCode)+']:' + {$ENDIF} else Result:=''; Result:='['+Siseblewordtostr(DayOfTheMonth(D),2)+'.'+Siseblewordtostr(MonthOfTheYear(D),2)+'.'+ Siseblewordtostr(YearOf(D),4)+' '+Siseblewordtostr(HourOfTheDay(D),2)+':'+ Siseblewordtostr(MinuteOfTheHour(D),2)+':'+Siseblewordtostr(SecondOfTheMinute(D),2)+'.' - +Siseblewordtostr(MilliSecondOfTheSecond(D),3)+'] '+Result+s+#13#10; + +Siseblewordtostr(MilliSecondOfTheSecond(D),3)+'] '+Result+s+sLineBreak; end; procedure TAGLog.Tab(); @@ -152,7 +159,7 @@ end; destructor TAGLog.Destroy(); begin -Self.Write(sLineBreak+CBaseTab+'Logging ended'+CBaseTab+sLineBreak); +Self.Write(CBaseTab+'Logging ended'+CBaseTab); inherited; end; @@ -164,14 +171,14 @@ tabstr:=''; inherited Create; end; -procedure TAGRamLog.Write(Text:WideString;o:TObject=nil); +procedure TAGRamLog.Write(Text:string;o:TObject=nil); begin buf:=buf+GenerateLogString(tabstr+Text,o); end; constructor TAGDiskLog.Create(FileName:WideString); +{$IFDEF MSWINDOWS} begin -{} Lock:=TCriticalSection.Create; WantTerminate:=False; tabs:=0; @@ -179,11 +186,23 @@ tabstr:=''; buf1:=''; LogHandle:=CreateFileW(Pwidechar(FileName),GENERIC_WRITE,0,nil,OPEN_ALWAYS,FILE_ATTRIBUTE_NORMAL,0); SetFilePointer(LogHandle,0,nil,FILE_END); -ThreadHandle:=CreateThread(nil,0,addr(TAGDiskLog.Init),self,0,ThreadID); +ThreadHandle:=CreateThread(nil,0,{$IFDEF FPC}Self.MethodAddress('Init'){$ELSE}addr(TAGDiskLog.Init){$ENDIF},self,0,ThreadID); +{$ELSE} +var + s:TBytes; +begin +try + s:=TFile.ReadAllBytes(FileName); +except + s:=TBytes.Create(); +end; +Stream:=TFileStream.Create(FileName,fmCreate+fmOpenReadWrite+fmShareDenyWrite); +Stream.WriteBuffer(s,length(s)); +{$ENDIF} inherited Create; -{} end; +{$IFDEF MSWINDOWS} procedure TAGDiskLog.Init();stdcall; var n:cardinal; @@ -215,17 +234,27 @@ begin sleep(0); end; end; +{$ENDIF} -procedure TAGDiskLog.Write(Text:WideString;o:TObject=nil); +procedure TAGDiskLog.Write(Text:string;o:TObject=nil); +{$IFDEF MSWINDOWS} begin Lock.Enter; buf1:=buf1+GenerateLogString(tabstr+text,o); Lock.Leave; +{$ELSE} +var + s:string; +begin +s:=GenerateLogString(tabstr+text,o); +Stream.WriteData(PWideChar(s),Length(s)*2); +{$ENDIF} end; destructor TAGDiskLog.Destroy(); begin inherited; +{$IFDEF MSWINDOWS} WantTerminate:=True; While WantTerminate do sleep(0); @@ -233,6 +262,9 @@ FreeAndNil(Lock); TerminateThread(ThreadID,0); CloseHandle(ThreadHandle); CloseHandle(LogHandle); +{$ELSE} +FreeAndNil(Stream); +{$ENDIF} end; constructor TAGNullLog.Create(); @@ -240,7 +272,7 @@ begin inherited; end; -procedure TAGNullLog.Write(Text:WideString;o:TObject=nil); +procedure TAGNullLog.Write(Text:string;o:TObject=nil); begin end; @@ -253,7 +285,7 @@ CommandLine:=Handele; inherited Create; end; -procedure TAGCommandLineLog.Write(Text:WideString;o:TObject=nil); +procedure TAGCommandLineLog.Write(Text:string;o:TObject=nil); var p:PWideChar; a,b:cardinal; @@ -279,13 +311,13 @@ end; {TAGStreamLog} -constructor TAGStreamLog.Create(stream:TStream); +constructor TAGStreamLog.Create(Astream:TStream); begin -Self.stream:=stream; +stream:=Astream; inherited Create; end; -procedure TAGStreamLog.Write(Text:WideString;o:TObject=nil); +procedure TAGStreamLog.Write(Text:string;o:TObject=nil); var s:string; begin @@ -295,33 +327,33 @@ end; {TAGCallBackLog} -constructor TAGCallBackLog.Create(CallBack:TCallBack); +constructor TAGCallBackLog.Create(ACallBack:TCallBack); begin -Self.CallBack:=CallBack; +CallBack:=ACallBack; inherited Create; end; -procedure TAGCallBackLog.Write(Text:WideString;o:TObject=nil); +procedure TAGCallBackLog.Write(Text:string;o:TObject=nil); begin CallBack(GenerateLogString(Text,o)); end; {TAGMultiLog} -constructor TAGMultiLog.Create(Default:TList); +constructor TAGMultiLog.Create(Default:TLogsList); begin //inherited Create; if Default<>nil then Logs:=Default else - Logs:=TList.Create; + Logs:=TLogsList.Create; end; -procedure TAGMultiLog.Write(Text:WideString;o:TObject=nil); +procedure TAGMultiLog.Write(Text:string;o:TObject=nil); var i:TAGLog; begin -for i in Logs.List do +for i in Logs do i.Write(Text,o); end; @@ -329,7 +361,7 @@ procedure TAGMultiLog.Tab(); var i:TAGLog; begin -for i in Logs.List do +for i in Logs do i.Tab(); end; @@ -337,7 +369,7 @@ procedure TAGMultiLog.UnTab(); var i:TAGLog; begin -for i in Logs.List do +for i in Logs do i.UnTab(); end; @@ -345,7 +377,7 @@ destructor TAGMultiLog.Destroy(); var i:TAGLog; begin -for i in Logs.List do +for i in Logs do i.Free(); FreeAndNil(Logs); //inherited; diff --git a/FPCTest/fpcunitproject1.lpi b/FPCTest/fpcunitproject1.lpi new file mode 100644 index 0000000..0f98ec1 --- /dev/null +++ b/FPCTest/fpcunitproject1.lpi @@ -0,0 +1,76 @@ + + + + + + + + + + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <VersionInfo> + <StringTable ProductVersion=""/> + </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <RequiredPackages Count="1"> + <Item1> + <PackageName Value="FCL"/> + </Item1> + </RequiredPackages> + <Units Count="3"> + <Unit0> + <Filename Value="fpcunitproject1.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="testcase1.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="TestCase1"/> + </Unit1> + <Unit2> + <Filename Value="..\AG.Logs.pas"/> + <IsPartOfProject Value="True"/> + </Unit2> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="fpcunitproject1"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <OtherUnitFiles Value=".."/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <CodeGeneration> + <TargetCPU Value="jvm"/> + </CodeGeneration> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/FPCTest/fpcunitproject1.lpr b/FPCTest/fpcunitproject1.lpr new file mode 100644 index 0000000..0168ef8 --- /dev/null +++ b/FPCTest/fpcunitproject1.lpr @@ -0,0 +1,25 @@ +program fpcunitproject1; + +{$mode objfpc}{$H+} + +uses + Classes, consoletestrunner, TestCase1; + +type + + { TMyTestRunner } + + TMyTestRunner = class(TTestRunner) + protected + // override the protected methods of TTestRunner to customize its behavior + end; + +var + Application: TMyTestRunner; + +begin + Application := TMyTestRunner.Create(nil); + Application.Initialize; + Application.Run; + Application.Free; +end. diff --git a/FPCTest/fpcunitproject1.lps b/FPCTest/fpcunitproject1.lps new file mode 100644 index 0000000..0d75166 --- /dev/null +++ b/FPCTest/fpcunitproject1.lps @@ -0,0 +1,90 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectSession> + <PathDelim Value="\"/> + <Version Value="10"/> + <BuildModes Active="Default"/> + <Units Count="6"> + <Unit0> + <Filename Value="fpcunitproject1.lpr"/> + <IsPartOfProject Value="True"/> + <EditorIndex Value="-1"/> + <WindowIndex Value="-1"/> + <TopLine Value="-1"/> + <CursorPos X="-1" Y="-1"/> + <UsageCount Value="20"/> + </Unit0> + <Unit1> + <Filename Value="testcase1.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="TestCase1"/> + <CursorPos X="98" Y="24"/> + <UsageCount Value="20"/> + <Loaded Value="True"/> + </Unit1> + <Unit2> + <Filename Value="..\AG.Logs.pas"/> + <IsPartOfProject Value="True"/> + <IsVisibleTab Value="True"/> + <EditorIndex Value="1"/> + <CursorPos X="89" Y="25"/> + <UsageCount Value="20"/> + <Loaded Value="True"/> + </Unit2> + <Unit3> + <Filename Value="C:\lazarus\fpc\3.0.4\source\rtl\win\wininc\redef.inc"/> + <EditorIndex Value="-1"/> + <TopLine Value="14"/> + <CursorPos X="29" Y="30"/> + <UsageCount Value="10"/> + </Unit3> + <Unit4> + <Filename Value="C:\lazarus\fpc\3.0.4\source\rtl\win\wininc\base.inc"/> + <EditorIndex Value="-1"/> + <TopLine Value="636"/> + <CursorPos X="6" Y="652"/> + <UsageCount Value="10"/> + </Unit4> + <Unit5> + <Filename Value="C:\lazarus\packager\registration\fcllaz.pas"/> + <EditorIndex Value="-1"/> + <CursorPos X="3" Y="11"/> + <UsageCount Value="10"/> + </Unit5> + </Units> + <JumpHistory Count="8" HistoryIndex="7"> + <Position1> + <Filename Value="testcase1.pas"/> + <Caret Line="31" Column="6" TopLine="15"/> + </Position1> + <Position2> + <Filename Value="testcase1.pas"/> + <Caret Line="31" Column="6" TopLine="15"/> + </Position2> + <Position3> + <Filename Value="testcase1.pas"/> + <Caret Line="33" Column="20" TopLine="17"/> + </Position3> + <Position4> + <Filename Value="..\AG.Logs.pas"/> + <Caret Line="25" Column="89"/> + </Position4> + <Position5> + <Filename Value="testcase1.pas"/> + <Caret Line="31" Column="5" TopLine="15"/> + </Position5> + <Position6> + <Filename Value="testcase1.pas"/> + <Caret Line="38" Column="2" TopLine="21"/> + </Position6> + <Position7> + <Filename Value="testcase1.pas"/> + <Caret Line="12" Column="50"/> + </Position7> + <Position8> + <Filename Value="testcase1.pas"/> + <Caret Line="24" Column="98"/> + </Position8> + </JumpHistory> + </ProjectSession> +</CONFIG> diff --git a/FPCTest/testcase1.pas b/FPCTest/testcase1.pas new file mode 100644 index 0000000..ad97e61 --- /dev/null +++ b/FPCTest/testcase1.pas @@ -0,0 +1,53 @@ +unit TestCase1; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, fpcunit, testutils, testregistry, AG.Logs; + +type + + TTestCase1= class(TTestCase) + published + procedure TestHookUp; + end; + +implementation + +procedure TTestCase1.TestHookUp; +var + MultiLog:TAGLog; + Stream:TStream; + s:TBytes; +begin +MultiLog:=TAGMultiLog.Create(nil); +(MultiLog as TAGMultiLog).Logs.Add(TAGNullLog.Create()); +(MultiLog as TAGMultiLog).Logs.Add(TAGDiskLog.Create('test.log')); +(MultiLog as TAGMultiLog).Logs.Add(TAGRamLog.Create()); +{$IFNDEF MSWINDOWS}(MultiLog as TAGMultiLog).Logs.Add(TAGCommandLineLog.Create(GetStdHandle(STD_OUTPUT_HANDLE))){$ENDIF}; +try + //s:=TFile.ReadAllBytes('test2.log'); +except + //s:=TBytes.Create(); +end; +Stream:=TFileStream.Create('test2.log',fmCreate+fmOpenReadWrite+fmShareDenyWrite); +Stream.WriteBuffer(s,length(s)); +(MultiLog as TAGMultiLog).Logs.Add(TAGStreamLog.Create(Stream)); +{(MultiLog as TAGMultiLog).Logs.Add(TAGCallBackLog.Create(procedure(s:string) + begin + Self.WriteLn(s); + end));} +MultiLog.Write('Str Test'); +MultiLog.Write('Str+Object Test',self); +FreeAndNil(MultiLog); +end; + + + +initialization + + RegisterTest(TTestCase1); +end. + diff --git a/Tests/Unit2.pas b/Tests/Unit2.pas index eea4294..16766f9 100644 --- a/Tests/Unit2.pas +++ b/Tests/Unit2.pas @@ -7,7 +7,7 @@ uses type [TestFixture] - TMyTestObject = class(TObject) + TMyTestObject = class(TObject) public // Sample Methods // Simple single Test @@ -28,7 +28,7 @@ MultiLog:=TAGMultiLog.Create(nil); (MultiLog as TAGMultiLog).Logs.Add(TAGNullLog.Create()); (MultiLog as TAGMultiLog).Logs.Add(TAGDiskLog.Create('test.log')); (MultiLog as TAGMultiLog).Logs.Add(TAGRamLog.Create()); -//(MultiLog as TAGMultiLog).Logs.Add(TAGCommandLineLog.Create(GetStdHandle())); +{$IFNDEF MSWINDOWS}(MultiLog as TAGMultiLog).Logs.Add(TAGCommandLineLog.Create(GetStdHandle(STD_OUTPUT_HANDLE))){$ENDIF}; try s:=TFile.ReadAllBytes('test2.log'); except @@ -37,8 +37,12 @@ end; Stream:=TFileStream.Create('test2.log',fmCreate+fmOpenReadWrite+fmShareDenyWrite); Stream.WriteBuffer(s,length(s)); (MultiLog as TAGMultiLog).Logs.Add(TAGStreamLog.Create(Stream)); -//(MultiLog as TAGMultiLog).Logs.Add(TAGCallBackLog.Create()); -MultiLog.Write('aaaaaaaaaaa',self); +(MultiLog as TAGMultiLog).Logs.Add(TAGCallBackLog.Create(procedure(s:string) + begin + Self.WriteLn(s); + end));{} +MultiLog.Write('Str Test'); +MultiLog.Write('Str+Object Test',self); FreeAndNil(MultiLog); end;