Changeset 89 for trunk/Packages


Ignore:
Timestamp:
Sep 6, 2012, 8:29:27 PM (12 years ago)
Author:
chronos
Message:
  • Přidáno: Balíček ModularSystem namísto vlastní implementace.
  • Upraveno: Aktualizace balíčku Common.
Location:
trunk/Packages
Files:
23 added
8 edited

Legend:

Unmodified
Added
Removed

  • trunk/Packages/Common/Common.lpk

    r84 r89  
    2121    <Description Value="Various libraries"/>
    2222    <License Value="GNU/GPL"/>
    23     <Version Minor="4"/>
    24     <Files Count="10">
     23    <Version Minor="7"/>
     24    <Files Count="15">
    2525      <Item1>
    2626        <Filename Value="StopWatch.pas"/>
    … …  
    6464        <UnitName Value="UPool"/>
    6565      </Item10>
     66      <Item11>
     67        <Filename Value="ULastOpenedList.pas"/>
     68        <HasRegisterProc Value="True"/>
     69        <UnitName Value="ULastOpenedList"/>
     70      </Item11>
     71      <Item12>
     72        <Filename Value="URegistry.pas"/>
     73        <UnitName Value="URegistry"/>
     74      </Item12>
     75      <Item13>
     76        <Filename Value="UJobProgressView.pas"/>
     77        <HasRegisterProc Value="True"/>
     78        <UnitName Value="UJobProgressView"/>
     79      </Item13>
     80      <Item14>
     81        <Filename Value="UXMLUtils.pas"/>
     82        <UnitName Value="UXMLUtils"/>
     83      </Item14>
     84      <Item15>
     85        <Filename Value="UApplicationInfo.pas"/>
     86        <HasRegisterProc Value="True"/>
     87        <UnitName Value="UApplicationInfo"/>
     88      </Item15>
    6689    </Files>
    6790    <i18n>
    … …  
    7093    </i18n>
    7194    <Type Value="RunAndDesignTime"/>
    72     <RequiredPkgs Count="3">
     95    <RequiredPkgs Count="2">
    7396      <Item1>
    7497        <PackageName Value="TemplateGenerics"/>
    7598      </Item1>
    7699      <Item2>
    77         <PackageName Value="LCL"/>
    78       </Item2>
    79       <Item3>
    80100        <PackageName Value="FCL"/>
    81101        <MinVersion Major="1" Valid="True"/>
    82       </Item3>
     102      </Item2>
    83103    </RequiredPkgs>
    84104    <UsageOptions>
    … …  
    88108      <Version Value="2"/>
    89109    </PublishOptions>
     110    <CustomOptions Items="ExternHelp" Version="2">
     111      <_ExternHelp Items="Count"/>
     112    </CustomOptions>
    90113  </Package>
    91114</CONFIG>

  • trunk/Packages/Common/Common.pas

    r84 r89  
    33 }
    44
    5 unit Common; 
     5unit Common;
    66
    77interface
    … …  
    99uses
    1010  StopWatch, UCommon, UDebugLog, UDelay, UPrefixMultiplier, UURI, UThreading,
    11   UMemory, UResetableThread, UPool, LazarusPackageIntf;
     11  UMemory, UResetableThread, UPool, ULastOpenedList, URegistry,
     12  UJobProgressView, UXMLUtils, UApplicationInfo, LazarusPackageIntf;
    1213
    1314implementation
    1415
    15 procedure Register; 
     16procedure Register;
    1617begin
    17   RegisterUnit('UDebugLog', @UDebugLog.Register);
    18 end;
     18  RegisterUnit('UDebugLog', @UDebugLog.Register);
     19  RegisterUnit('ULastOpenedList', @ULastOpenedList.Register);
     20  RegisterUnit('UJobProgressView', @UJobProgressView.Register);
     21  RegisterUnit('UApplicationInfo', @UApplicationInfo.Register);
     22end;
    1923
    2024initialization
    21   RegisterPackage('Common', @Register); 
     25  RegisterPackage('Common', @Register);
    2226end.

  • trunk/Packages/Common/StopWatch.pas

    r84 r89  
    4343  fIsHighResolution := QueryPerformanceFrequency(fFrequency) ;
    4444  {$ELSE}
    45   raise Exception.Create('Not implemeneted');
     45  fIsHighResolution := False;
    4646  {$ENDIF}
    4747  if NOT fIsHighResolution then fFrequency := MSecsPerSec;
    … …  
    6161    QueryPerformanceCounter(lInt)
    6262    {$ELSE}
    63     raise Exception.Create('Not implemeneted')
    6463    {$ENDIF}
    6564  else

  • trunk/Packages/Common/UCommon.pas

    r84 r89  
    77uses
    88  {$IFDEF Windows}Windows,{$ENDIF}
    9   Classes, SysUtils, StrUtils, Dialogs, Process,
     9  Classes, SysUtils, StrUtils, Dialogs, Process, LCLIntf,
    1010  FileUtil; //, ShFolder, ShellAPI;
    1111
    … …  
    4545function BCDToInt(Value: Byte): Byte;
    4646function CompareByteArray(Data1, Data2: TArrayOfByte): Boolean;
    47 {$IFDEF Windows}
    4847function GetUserName: string;
    4948function LoggedOnUserNameEx(Format: TUserNameFormat): string;
    50 {$ENDIF}
    5149function SplitString(var Text: string; Count: Word): string;
    5250function GetBit(Variable: QWord; Index: Byte): Boolean;
    53 procedure SetBit(var Variable: QWord; Index: Byte; State: Boolean);
    54 procedure SetBit(var Variable: Cardinal; Index: Byte; State: Boolean);
    55 procedure SetBit(var Variable: Word; Index: Byte; State: Boolean);
     51procedure SetBit(var Variable: QWord; Index: Byte; State: Boolean); overload;
     52procedure SetBit(var Variable: Cardinal; Index: Byte; State: Boolean); overload;
     53procedure SetBit(var Variable: Word; Index: Byte; State: Boolean); overload;
    5654function AddLeadingZeroes(const aNumber, Length : integer) : string;
    5755function LastPos(const SubStr: String; const S: String): Integer;
    … …  
    6159procedure DeleteFiles(APath, AFileSpec: string);
    6260procedure OpenWebPage(URL: string);
     61procedure OpenFileInShell(FileName: string);
     62procedure ExecuteProgram(CommandLine: string);
     63procedure FreeThenNil(var Obj);
    6364
    6465
    … …  
    283284  L: LongWord;
    284285begin
     286
    285287  L := MAX_USERNAME_LENGTH + 2;
    286288  SetLength(Result, L);
    287   if Windows.GetUserName(PChar(Result), L) and (L > 0) then
    288     SetLength(Result, StrLen(PChar(Result))) else
    289     Result := '';
     289  if Windows.GetUserName(PChar(Result), L) and (L > 0) then begin
     290    SetLength(Result, StrLen(PChar(Result)));
     291    Result := UTF8Encode(Result);
     292  end else Result := '';
    290293end;
    291294
    … …  
    314317  end else Result := GetUserName;
    315318end;
     319{$ELSE}
     320function GetUserName: string;
     321begin
     322  Result := '';
     323end;
     324
     325function LoggedOnUserNameEx(Format: TUserNameFormat): string;
     326begin
     327  Result := '';
     328end;
     329
    316330{$ENDIF}
    317331
    … …  
    365379end;
    366380
     381procedure ExecuteProgram(CommandLine: string);
     382var
     383  Process: TProcess;
     384begin
     385  try
     386    Process := TProcess.Create(nil);
     387    Process.CommandLine := CommandLine;
     388    Process.Options := [poNoConsole];
     389    Process.Execute;
     390  finally
     391    Process.Free;
     392  end;
     393end;
     394
     395procedure FreeThenNil(var Obj);
     396begin
     397  TObject(Obj).Free;
     398  TObject(Obj) := nil;
     399end;
     400
    367401procedure OpenWebPage(URL: string);
    368402var
    … …  
    370404  Browser, Params: string;
    371405begin
    372   try
     406  OpenURL(URL);
     407  {try
    373408    Process := TProcess.Create(nil);
    374409    Browser := '';
    … …  
    381416  finally
    382417    Process.Free;
    383   end;
    384 end;
    385 
     418  end;}
     419end;
     420
     421procedure OpenFileInShell(FileName: string);
     422begin
     423  ExecuteProgram('cmd.exe /c start "' + FileName + '"');
     424end;
    386425
    387426initialization

  • trunk/Packages/Common/UDebugLog.pas

    r84 r89  
    66
    77uses
    8   Classes, SysUtils, FileUtil;
     8  Classes, SysUtils, FileUtil, SpecializedList, SyncObjs;
    99
    1010type
    … …  
    2929    procedure SetMaxCount(const AValue: Integer);
    3030  public
    31     Items: TThreadList;
     31    Items: TListObject;
     32    Lock: TCriticalSection;
    3233    procedure Add(Group: string; Text: string);
    3334    procedure WriteToFile(Text: string);
    … …  
    5758
    5859procedure TDebugLog.SetMaxCount(const AValue: Integer);
    59 var
    60   List: TList;
    61   I: Integer;
    6260begin
    6361  if FMaxCount = AValue then Exit;
    6462  FMaxCount := AValue;
    65   List := Items.LockList;
    66   if List.Count > 0 then begin
    67     for I := AValue to List.Count - 1 do
    68       TDebugLogItem(List[I]).Free;
    69     List.Count := AValue;
     63  try
     64    Lock.Acquire;
     65    if Items.Count > FMaxCount then Items.Count := AValue;
     66  finally
     67    Lock.Release;
    7068  end;
    71   Items.UnlockList;
    7269end;
    7370
    7471procedure TDebugLog.Add(Group: string; Text: string);
    7572var
    76   I: Integer;
    77   List: TList;
    7873  NewItem: TDebugLogItem;
    7974begin
    … …  
    8378  NewItem.Text := Text;
    8479
    85   List := Items.LockList;
    86   List.Insert(0, NewItem);
    87   if List.Count > MaxCount then begin
    88     TDebugLogItem(List.Items[List.Count - 1]).Free;
    89     List.Delete(List.Count - 1);
    90   end;
    91   Items.UnlockList;
     80  try
     81    Lock.Acquire;
     82    Items.Insert(0, NewItem);
     83    if Items.Count > MaxCount then begin
     84      Items.Delete(Items.Count - 1);
     85    end;
    9286
    93   if WriteToFileEnable then begin
    94     if Group <> '' then Group := Group + '[' + Group + '] ';
    95     WriteToFile(Group + Text);
     87    if WriteToFileEnable then begin
     88      if Group <> '' then Group := Group + '[' + Group + '] ';
     89      WriteToFile(Group + Text);
     90    end;
     91  finally
     92    Lock.Release;
    9693  end;
    9794  if Assigned(FOnNewItem) then
    … …  
    113110    LogFile.WriteBuffer(Text[1], Length(Text));
    114111  finally
    115     LogFile.Free;
     112    FreeAndNil(LogFile);
    116113  end;
    117114end;
    … …  
    120117begin
    121118  inherited;
    122   Items := TThreadList.Create;
     119  Items := TListObject.Create;
     120  Lock := TCriticalSection.Create;
    123121  MaxCount := 100;
    124122  FileName := 'DebugLog.txt';
    … …  
    127125
    128126destructor TDebugLog.Destroy;
    129 var
    130   List: TList;
    131   I: Integer;
    132127begin
    133   List := Items.LockList;
    134   for I := 0 to List.Count - 1 do
    135     TDebugLogItem(List[I]).Free;
    136128  Items.Free;
     129  Lock.Free;
    137130  inherited;
    138131end;

  • trunk/Packages/Common/UMemory.pas

    r84 r89  
    2424    constructor Create;
    2525    destructor Destroy; override;
     26    procedure WriteMemory(Position: Integer; Memory: TMemory);
     27    procedure ReadMemory(Position: Integer; Memory: TMemory);
    2628    property Data: PByte read FData;
    2729    property Size: Integer read FSize write SetSize;
    … …  
    108110end;
    109111
     112procedure TMemory.WriteMemory(Position: Integer; Memory: TMemory);
     113begin
     114  Move(Memory.FData, PByte(@FData + Position)^, Memory.Size);
     115end;
     116
     117procedure TMemory.ReadMemory(Position: Integer; Memory: TMemory);
     118begin
     119  Move(PByte(@FData + Position)^, Memory.FData, Memory.Size);
     120end;
     121
    110122end.
    111123

  • trunk/Packages/Common/UResetableThread.pas

    r84 r89  
    5454    procedure MethodFinish(Sender: TObject);
    5555  protected
    56     procedure ThreadException(Sender: TObject; E: Exception);
    5756    function NewItemObject: TObject; override;
    5857  public
    5958    LastExceptionClass: TClass;
    6059    LastExceptionMessage: string;
     60    procedure ThreadException(Sender: TObject; E: Exception);
    6161    procedure CheckException;
    6262    procedure WaitForEmpty;
    … …  
    273273procedure TThreadPool.RunInThread(AMethod: TMethodCall);
    274274begin
    275   CheckException;
    276   with TResetableThread(Acquire) do begin
    277     Method := AMethod;
    278     OnFinished := MethodFinish;
    279     Start;
     275  try
     276    with TResetableThread(Acquire) do begin
     277      Method := AMethod;
     278      OnFinished := MethodFinish;
     279      Start;
     280    end;
     281  finally
     282    CheckException;
    280283  end;
    281284end;

  • trunk/Packages/Common/UThreading.pas

    r84 r89  
    1717  TVirtualThread = class
    1818  private
     19    function GetFinished: Boolean; virtual; abstract;
    1920    function GetFreeOnTerminate: Boolean; virtual; abstract;
    2021    function GetPriority: TThreadPriority; virtual; abstract;
    … …  
    4243    property Priority: TThreadPriority read GetPriority write SetPriority;
    4344    property Terminated: Boolean read GetTerminated write SetTerminated;
     45    property Finished: Boolean read GetFinished;
    4446    property ThreadId: Integer read GetThreadId;
    4547  end;
    … …  
    6163  private
    6264    FTerminated: Boolean;
     65    FFinished: Boolean;
    6366    FThread: TListedThreadExecute;
     67    function GetFinished: Boolean; override;
    6468    function GetFreeOnTerminate: Boolean; override;
    6569    function GetPriority: TThreadPriority; override;
    … …  
    160164procedure Synchronize(Method: TMethodCall);
    161165var
    162   I: Integer;
    163166  Thread: TVirtualThread;
    164167begin
    … …  
    172175end;
    173176
    174 
    175177{ TThreadList }
    176178
    … …  
    196198begin
    197199  try
    198     Parent.Execute;
    199   except
    200     on E: Exception do
    201       if Assigned(OnException) then
    202         OnException(Parent.FThread, E);
     200    try
     201      Parent.Execute;
     202    except
     203      on E: Exception do
     204        if Assigned(OnException) then
     205          OnException(Parent.FThread, E);
     206    end;
     207  finally
     208    Parent.FFinished := True;
    203209  end;
    204210end;
    205211
    206212{ TListedThread }
     213
     214function TListedThread.GetFinished: Boolean;
     215begin
     216  Result := FFinished;
     217end;
    207218
    208219function TListedThread.GetFreeOnTerminate: Boolean;
    … …  
    255266  const StackSize: SizeUInt);
    256267begin
     268  FFinished := False;
     269  FTerminated := False;
     270
    257271  FThread := TListedThreadExecute.Create(True, StackSize);
    258272  FThread.Parent := Self;
    … …  
    289303  I: Integer;
    290304begin
     305  if Terminated then Exit;
    291306  SysUtils.Sleep(Delay mod Quantum);
    292307  for I := 1 to (Delay div Quantum) do begin
Note: See TracChangeset for help on using the changeset viewer.