Changeset 250


Ignore:
Timestamp:
Jun 13, 2011, 8:00:17 AM (13 years ago)
Author:
george
Message:
  • Modified: Unit UCommon in CoolWeb package used form package Common as dependency.
Files:
1 added
1 deleted
9 edited

Legend:

Unmodified
Added
Removed

  • Common/UCommon.pas

    r245 r250  
    3636function TryHexToInt(Data: string; var Value: Integer): Boolean;
    3737function TryBinToInt(Data: string; var Value: Integer): Boolean;
     38function BinToHexString(Source: AnsiString): string;
    3839//function DelTree(DirName : string): Boolean;
    3940//function GetSpecialFolderPath(Folder: Integer): string;
    … …  
    5758implementation
    5859
     60function BinToHexString(Source: AnsiString): string;
     61var
     62  I: Integer;
     63begin
     64  for I := 1 to Length(Source) do begin
     65    Result := Result + LowerCase(IntToHex(Ord(Source[I]), 2));
     66  end;
     67end;
     68
     69
    5970procedure DeleteFiles(APath, AFileSpec: string);
    6071var

  • Common/UDebugLog.pas

    r118 r250  
    2121  { TDebugLog }
    2222
    23   TDebugLog = class
     23  TDebugLog = class(TComponent)
    2424  private
     25    FFileName: string;
    2526    FOnNewItem: TNewItemEvent;
    2627  public
    27     FileName: string;
    2828    WriteToFileEnable: Boolean;
    2929    Items: TThreadList;
    … …  
    3232    procedure WriteToFile(Text: string);
    3333    property OnNewItem: TNewItemEvent read FOnNewItem write FOnNewItem;
    34     constructor Create;
     34    constructor Create(AOwner: TComponent); override;
    3535    destructor Destroy; override;
     36  published
     37    property FileName: string read FFileName write FFileName;
    3638  end;
    3739
    … …  
    8587end;
    8688
    87 constructor TDebugLog.Create;
     89constructor TDebugLog.Create(AOwner: TComponent);
    8890begin
     91  inherited;
    8992  Items := TThreadList.Create;
    9093  MaxCount := 100;
    … …  
    105108end;
    106109
    107 initialization
    108 
    109 DebugLog := TDebugLog.Create;
    110 
    111 finalization
    112 
    113 DebugLog.Free;
    114 
    115110end.
    116111

  • CoolStreaming/CoolStreaming.lpk

    r233 r250  
    4949    </Files>
    5050    <Type Value="RunAndDesignTime"/>
    51     <RequiredPkgs Count="2">
     51    <RequiredPkgs Count="3">
    5252      <Item1>
    53         <PackageName Value="TemplateGenerics"/>
     53        <PackageName Value="LCL"/>
    5454      </Item1>
    5555      <Item2>
     56        <PackageName Value="TemplateGenerics"/>
     57      </Item2>
     58      <Item3>
    5659        <PackageName Value="FCL"/>
    5760        <MinVersion Major="1" Valid="True"/>
    58       </Item2>
     61      </Item3>
    5962    </RequiredPkgs>
    6063    <UsageOptions>

  • Generics/TemplateGenerics/TemplateGenerics.lpk

    r222 r250  
    8383      <Item14>
    8484        <Filename Value="Generic\GenericStream.inc"/>
     85        <UnitName Value="GenericStream"/>
    8586      </Item14>
    8687      <Item15>
    … …  
    132133    </RequiredPkgs>
    133134    <UsageOptions>
    134       <IncludePath Value="Generic"/>
    135135      <UnitPath Value="$(PkgOutDir)"/>
    136136    </UsageOptions>

  • Network/CoolWeb/CoolWeb.lpk

    r238 r250  
    2020    <License Value="GNU/GPL"/>
    2121    <Version Minor="2"/>
    22     <Files Count="17">
     22    <Files Count="16">
    2323      <Item1>
    2424        <Filename Value="WebServer/UHTTPServer.pas"/>
    … …  
    6363      </Item9>
    6464      <Item10>
    65         <Filename Value="Common/UCommon.pas"/>
    66         <UnitName Value="UCommon"/>
     65        <Filename Value="Common/UHtmlClasses.pas"/>
     66        <UnitName Value="UHtmlClasses"/>
    6767      </Item10>
    6868      <Item11>
    69         <Filename Value="Common/UHtmlClasses.pas"/>
    70         <UnitName Value="UHtmlClasses"/>
     69        <Filename Value="Common/UMemoryStreamEx.pas"/>
     70        <UnitName Value="UMemoryStreamEx"/>
    7171      </Item11>
    7272      <Item12>
    73         <Filename Value="Common/UMemoryStreamEx.pas"/>
    74         <UnitName Value="UMemoryStreamEx"/>
     73        <Filename Value="Common/UMIMEType.pas"/>
     74        <UnitName Value="UMIMEType"/>
    7575      </Item12>
    7676      <Item13>
    77         <Filename Value="Common/UMIMEType.pas"/>
    78         <UnitName Value="UMIMEType"/>
     77        <Filename Value="Common/UPool.pas"/>
     78        <UnitName Value="UPool"/>
    7979      </Item13>
    8080      <Item14>
    81         <Filename Value="Common/UPool.pas"/>
    82         <UnitName Value="UPool"/>
     81        <Filename Value="Common/UResetableThread.pas"/>
     82        <UnitName Value="UResetableThread"/>
    8383      </Item14>
    8484      <Item15>
    85         <Filename Value="Common/UResetableThread.pas"/>
    86         <UnitName Value="UResetableThread"/>
     85        <Filename Value="Common/UXmlClasses.pas"/>
     86        <UnitName Value="UXmlClasses"/>
    8787      </Item15>
    8888      <Item16>
    89         <Filename Value="Common/UXmlClasses.pas"/>
    90         <UnitName Value="UXmlClasses"/>
    91       </Item16>
    92       <Item17>
    9389        <Filename Value="WebServer/UWebPage.pas"/>
    9490        <UnitName Value="UWebPage"/>
    95       </Item17>
     91      </Item16>
    9692    </Files>
    9793    <Type Value="RunAndDesignTime"/>
    98     <RequiredPkgs Count="3">
     94    <RequiredPkgs Count="4">
    9995      <Item1>
     96        <PackageName Value="Common"/>
     97      </Item1>
     98      <Item2>
    10099        <PackageName Value="TemplateGenerics"/>
    101100        <MaxVersion Minor="3" Valid="True"/>
    102101        <MinVersion Minor="3" Valid="True"/>
    103       </Item1>
    104       <Item2>
    105         <PackageName Value="synapse"/>
    106102      </Item2>
    107103      <Item3>
     104        <PackageName Value="synapse"/>
     105      </Item3>
     106      <Item4>
    108107        <PackageName Value="FCL"/>
    109108        <MinVersion Major="1" Valid="True"/>
    110       </Item3>
     109      </Item4>
    111110    </RequiredPkgs>
    112111    <UsageOptions>

  • Network/CoolWeb/CoolWeb.pas

    r238 r250  
    99uses
    1010  UHTTPServer, UHTTPServerCGI, UHTTPServerTCP, UHTTPSessionFile,
    11   UHTTPSessionMySQL, USqlDatabase, UTCPServer, UPageList, UUser, UCommon,
    12   UHtmlClasses, UMemoryStreamEx, UMIMEType, UPool, UResetableThread,
    13   UXmlClasses, UWebPage, LazarusPackageIntf;
     11  UHTTPSessionMySQL, USqlDatabase, UTCPServer, UPageList, UUser, UHtmlClasses,
     12  UMemoryStreamEx, UMIMEType, UPool, UResetableThread, UXmlClasses, UWebPage,
     13  LazarusPackageIntf;
    1414
    1515implementation

  • Network/CoolWeb/Persistence/USqlDatabase.pas

    r238 r250  
    2020
    2121  TSetClientCapabilities = set of TClientCapabilities;
     22
     23  TLogEvent = procedure(Sender: TObject; Text: string) of object;
    2224
    2325  TDbRows = class(TListObject)
    … …  
    4143    FDatabase: string;
    4244    FUserName: string;
     45    FOnLogQuery: TLogEvent;
    4346    procedure mySQLClient1ConnectError(Sender: TObject; Msg: String);
    4447    function GetConnected: Boolean;
    … …  
    5659    procedure Query(DbRows: TDbRows; Data: string);
    5760    procedure Select(DbRows: TDbRows; ATable: string; Filter: string = '*'; Condition: string = '1');
    58     procedure Delete(ATable: string; Condition: string = '1');
    59     procedure Insert(ATable: string; Data: TDictionaryStringString);
    60     procedure Update(ATable: string; Data: TDictionaryStringString; Condition: string = '1');
    61     procedure Replace(ATable: string; Data: TDictionaryStringString);
     61    procedure Delete(ATable: string; Condition: string = '1';
     62      Schema: string = '');
     63    procedure Insert(ATable: string; Data: TDictionaryStringString;
     64      Schema: string = '');
     65    procedure Update(ATable: string; Data: TDictionaryStringString;
     66      Condition: string = '1'; Schema: string = '');
     67    procedure Replace(ATable: string; Data: TDictionaryStringString;
     68      Schema: string = '');
    6269    procedure Connect;
    6370    procedure Disconnect;
    … …  
    7582    property Password: string read FPassword write FPassword;
    7683    property Encoding: string read FEncoding write FEncoding;
     84    property OnLogQuery: TLogEvent read FOnLogQuery write FOnLogQuery;
    7785  end;
    7886
    … …  
    193201end;
    194202
    195 procedure TSqlDatabase.Insert(ATable: string; Data: TDictionaryStringString);
     203procedure TSqlDatabase.Insert(ATable: string; Data: TDictionaryStringString;
     204  Schema: string);
    196205var
    197206  DbNames: string;
    … …  
    215224  try
    216225    DbResult := TDbRows.Create;
    217     Query(DbResult, 'INSERT INTO `' + ATable + '` (' + DbNames + ') VALUES (' + DbValues + ')');
     226    if Schema <> '' then Schema := '`' + Schema + '`.';
     227    Query(DbResult, 'INSERT INTO ' + Schema + '`' + ATable + '` (' + DbNames + ') VALUES (' + DbValues + ')');
    218228  finally
    219229    DbResult.Free;
    … …  
    228238begin
    229239  DbRows.Clear;
    230   //DebugLog('SqlDatabase query: '+Data);
     240  if Assigned(FOnLogQuery) then FOnLogQuery(Self, Data);
    231241  LastQuery := Data;
    232242  mysql_query(FSession, PChar(Data));
    … …  
    252262end;
    253263
    254 procedure TSqlDatabase.Replace(ATable: string; Data: TDictionaryStringString);
     264procedure TSqlDatabase.Replace(ATable: string; Data: TDictionaryStringString;
     265  Schema: string = '');
    255266var
    256267  DbNames: string;
    … …  
    274285  try
    275286    DbResult := TDbRows.Create;
    276     Query(DbResult, 'REPLACE INTO `' + ATable + '` (' + DbNames + ') VALUES (' + DbValues + ')');
     287    if Schema <> '' then Schema := '`' + Schema + '`.';
     288    Query(DbResult, 'REPLACE INTO ' + Schema + '`' + ATable + '` (' + DbNames + ') VALUES (' + DbValues + ')');
    277289  finally
    278290    DbResult.Free;
    … …  
    286298end;
    287299
    288 procedure TSqlDatabase.Update(ATable: string; Data: TDictionaryStringString; Condition: string = '1');
     300procedure TSqlDatabase.Update(ATable: string; Data: TDictionaryStringString;
     301  Condition: string = '1'; Schema: string = '');
    289302var
    290303  DbValues: string;
    … …  
    304317  try
    305318    DbResult := TDbRows.Create;
    306     Query(DbResult, 'UPDATE `' + ATable + '` SET (' + DbValues + ') WHERE ' + Condition);
     319    if Schema <> '' then Schema := '`' + Schema + '`.';
     320    Query(DbResult, 'UPDATE ' + Schema + '`' + ATable + '` SET (' + DbValues + ') WHERE ' + Condition);
    307321  finally
    308322    DbResult.Free;
    … …  
    315329end;
    316330
    317 procedure TSqlDatabase.Delete(ATable: string; Condition: string = '1');
     331procedure TSqlDatabase.Delete(ATable: string; Condition: string = '1';
     332  Schema: string = '');
    318333var
    319334  DbResult: TDbRows;
    … …  
    322337  try
    323338    DbResult := TDbRows.Create;
    324     Query(DbResult, 'DELETE FROM `' + ATable + '` WHERE ' + Condition);
     339    if Schema <> '' then Schema := '`' + Schema + '`.';
     340    Query(DbResult, 'DELETE FROM ' + Schema + '`' + ATable + '` WHERE ' + Condition);
    325341  finally
    326342    DbResult.Free;

  • Network/CoolWeb/WebServer/UHTTPServer.pas

    r237 r250  
    7878
    7979  THTTPSessionStorage = class(TComponent)
     80  public
    8081    procedure Load(HandlerData: THTTPHandlerData); virtual;
    8182    procedure Save(HandlerData: THTTPHandlerData); virtual;

  • Network/CoolWeb/WebServer/UHTTPSessionFile.pas

    r237 r250  
    66
    77uses
    8   Classes, SysUtils, UHTTPServer, syncobjs, synacode, UCommon;
     8  Classes, SysUtils, UHTTPServer, syncobjs, synacode, UCommon, FileUtil;
    99
    1010type
    … …  
    3737implementation
    3838
     39resourcestring
     40  SCantCreateSessionStorageDirectory = 'Can''t create session storage directory.';
     41
    3942procedure Register;
    4043begin
    … …  
    4851begin
    4952  Result := BinToHexString(SHA1(FloatToStr(Now)));
    50   while FileExists(Directory + '/' + Result) do
     53  while FileExistsUTF8(Directory + DirectorySeparator + Result) do
    5154    Result := BinToHexString(SHA1(FloatToStr(Now)));
    5255end;
    … …  
    7174  try
    7275    Lock.Acquire;
    73     SessionFile := Directory + '/' + HandlerData.SessionId;
    74     if FileExists(SessionFile) then
     76    SessionFile := Directory + DirectorySeparator + HandlerData.SessionId;
     77    if FileExistsUTF8(SessionFile) then
    7578      HandlerData.Session.LoadFromFile(SessionFile)
    7679      else HandlerData.SessionId := GetNewSessionId;
    … …  
    8790  try
    8891    Lock.Acquire;
    89     SessionFile := Directory + '/' + HandlerData.SessionId;
     92    SessionFile := Directory + DirectorySeparator + HandlerData.SessionId;
    9093    ForceDirectories(Directory);
    91     if DirectoryExists(Directory) then begin
     94    if DirectoryExistsUTF8(Directory) then begin
    9295      DeleteFile(SessionFile);
    9396      HandlerData.Session.SaveToFile(SessionFile)
    94     end else raise Exception.Create('Can''t create session storage directory.');
     97    end else raise Exception.Create(SCantCreateSessionStorageDirectory);
    9598
    9699    HandlerData.Response.Cookies.Values[SessionIdCookieName] := HandlerData.SessionId;
Note: See TracChangeset for help on using the changeset viewer.