Changeset 35 for Network

Timestamp:

Jul 1, 2010, 2:11:01 PM (14 years ago)

Author:

george

Message:

• Přidáno: Třídy pro běh web serveru, asociativní pole, dávkový přenos paketů.

Location:

Network

Files:

• HTTP (added)
• HTTP/Modules (added)
• HTTP/Modules/UPermission.pas (added)
• HTTP/Modules/UUser.pas (added)
• HTTP/UHTMLClasses.pas (added)
• HTTP/UHTMLControls.pas (added)
• HTTP/UHTTPServer.pas (added)
• HTTP/UHTTPSessionFile.pas (added)
• HTTP/UHTTPSessionMySQL.pas (added)
• HTTP/UWebObject.pas (added)
• HTTP/UWebServer.pas (added)
• MysqlClient/USqlDatabase.pas (modified) (17 diffs)
• UMimeType.pas (added)

Network/MysqlClient/USqlDatabase.pas

@@ -1 +1 @@
 unit USqlDatabase;
 
-// Upraveno: 24.2.2008
+{$mode Delphi}{$H+}
+// Upraveno: 16.12.2009
 
 interface
 
 uses
-  SysUtils, Classes, Dialogs, mysql, TypInfo;
+  SysUtils, Classes, Dialogs, mysql50, TypInfo;
 
 type
+  EQueryError = Exception;
+
   TClientCapabilities = (_CLIENT_LONG_PASSWORD, _CLIENT_FOUND_ROWS,
     _CLIENT_LONG_FLAG, _CLIENT_CONNECT_WITH_DB, _CLIENT_NO_SCHEMA,
@@ -44 +47 @@
     FSession: PMYSQL;
     FConnected: Boolean;
-    FOnError: TNotifyEvent;
     FDatabase: string;
     function GetConnected: Boolean;
@@ -57 +59 @@
     UserName: string;
     Password: string;
+    Encoding: string;
     Table: string;
     RepeatLastAction: Boolean;
@@ -75 +78 @@
     property LastErrorNumber: Integer read GetLastErrorNumber;
     property Connected: Boolean read GetConnected;
-    property OnError: TNotifyEvent read FOnError write FOnError;
     constructor Create;
     destructor Destroy; override;
@@ -111 +113 @@
 begin
   S := FloatToStr(F);
-  if Pos(',',S) > 0 then S[Pos(',',S)] := '.';
+  if Pos(',', S) > 0 then S[Pos(',',S)] := '.';
   Result := S;
 end;
@@ -117 +119 @@
 function MySQLStrToFloat(S: string): Real;
 begin
-  if Pos('.',S) > 0 then  S[Pos('.',S)] := ',';
+  if Pos('.', S) > 0 then S[Pos('.',S)] := ',';
   Result := StrToFloat(S);
 end;
@@ -137 +139 @@
   end else FConnected := False;
   CheckError;
-  Rows := Query('SET NAMES cp1250');
+  Rows := Query('SET NAMES ' + Encoding);
   Rows.Free;
 end;
@@ -152 +154 @@
   DbNames := '';
   DbValues := '';
-  for I := 0 to Data.Count-1 do begin
+  for I := 0 to Data.Count - 1 do begin
     Value := Data.ValuesAtIndex[I];
     StringReplace(Value, '"', '\"', [rfReplaceAll]);
@@ -169 +171 @@
   I, II: Integer;
   DbResult: PMYSQL_RES;
-  DbRow: PMYSQL_ROW;
+  DbRow: MYSQL_ROW;
 begin
   //DebugLog('SqlDatabase query: '+Data);
@@ -185 +187 @@
     if Assigned(DbResult) then begin
       Result.Count := mysql_num_rows(DbResult);
-      for I := 0 to Result.Count-1 do begin
+      for I := 0 to Result.Count - 1 do begin
         DbRow := mysql_fetch_row(DbResult);
         Result[I] := TAssociativeArray.Create;
         with Result[I] do begin
-          for II := 0 to mysql_num_fields(DbResult)-1 do begin
-            Add(mysql_fetch_field_direct(DbResult, II)^.name + NameValueSeparator + DbRow^[II]);
+          for II := 0 to mysql_num_fields(DbResult) - 1 do begin
+            Add(mysql_fetch_field_direct(DbResult, II)^.Name +
+              NameValueSeparator + PChar((DbRow + II)^));
           end;
         end;
@@ -217 +220 @@
   DbNames := '';
   DbValues := '';
-  for I := 0 to Data.Count-1 do begin
+  for I := 0 to Data.Count - 1 do begin
     Value := Data.ValuesAtIndex[I];
     StringReplace(Value, '"', '\"', [rfReplaceAll]);
@@ -245 +248 @@
   Table := ATable;
   DbValues := '';
-  for I := 0 to Data.Count-1 do begin
+  for I := 0 to Data.Count - 1 do begin
     Value := Data.ValuesAtIndex[I];
     StringReplace(Value, '"', '\"', [rfReplaceAll]);
@@ -283 +286 @@
 begin
   Result := '';
-  for I := 0 to Count-1 do begin
+  for I := 0 to Count - 1 do begin
     Result := Result + Names[I] + '=' + ValuesAtIndex[I] + ',';
   end;
@@ -319 +322 @@
   inherited;
   FSession := nil;
+  Encoding := 'utf8';
 end;
 
@@ -332 +336 @@
   I: Integer;
 begin
-  for I := 0 to Count - 1 do Data[I].Free;
+  for I := 0 to Count - 1 do
+    Data[I].Free;
   inherited;
 end;
@@ -364 +369 @@
 begin
   Result := LastErrorNumber <> 0;
-  if Result and Assigned(OnError) then OnError(Self);
+  if Result then
+    raise EQueryError.Create('Database query error: "' + LastErrorMessage + '"');
 end;
 
@@ -380 +386 @@
 
 procedure TSqlDatabase.CreateTable(Name: string);
-begin
-  Query('CREATE TABLE `' + Name + '`' +
-  ' (`id` INT NOT NULL AUTO_INCREMENT, PRIMARY KEY (`id`));');
+var
+  DbRows: TDbRows;
+begin
+  DbRows := Query('CREATE TABLE `' + Name + '`' +
+  ' (`Id` INT NOT NULL AUTO_INCREMENT, PRIMARY KEY (`Id`));');
+  DbRows.Destroy;
 end;