Модуль, содержащий несколько удобств для работы с MSSQL посредством ADO |
Previous Top Next |
Code: |
{ **** UBPFD *********** by delphibase.endimus.com **** >> , MSSQL ADO
: Windows, Classes, SysUtils, ADODB, ADOInt, ActiveX, Controls, Variants, ComObj : Delirium, Master_BRAIN@beep.ru, ICQ:118395746, Copyright: Delirium : 30 2002 . ***************************************************** }
unit ThADO;
interface
uses Windows, Classes, SysUtils, ADODB, ADOInt, ActiveX, Controls, Variants, ComObj;
type // TThreadADOQueryOnAfterWork = procedure(AHandle: THandle; RecordSet: _RecordSet; Active: Boolean) of object; // TThADOQuery = class(TThread) private ADOQuery: TADOQuery; FAfterWork: TThreadADOQueryOnAfterWork;
protected procedure DoWork; procedure Execute; override;
public constructor Create;
published property OnAfterWork: TThreadADOQueryOnAfterWork read FAfterWork write FAfterWork; end; // ADO TThreadADOQuery = class(TObject) private FAfterWork: TThreadADOQueryOnAfterWork; FActive: Boolean; FQuery: TThADOQuery; FHandle: THandle;
protected procedure AfterWork(AHandle: THandle; RecordSet: _RecordSet; Active: Boolean);
public constructor Create(aConnectionString: string);
// // ( Batch=True - LockType=ltBatchOptimistic) procedure StartWork(aSQL: string; Batch: boolean = False); // / (True - " ") function PauseWork: boolean; // ( ) procedure StopWork;
published property Active: Boolean read FActive; property Handle: THandle read FHandle; property OnAfterWork: TThreadADOQueryOnAfterWork read FAfterWork write FAfterWork; end;
// MSSQL function RecordSetToTempTableForMSSQL(Connection: TADOConnection; RecordSet: _RecordSet; TableName: string): boolean; // DBF, function RecordSetToDBF(RecordSet: _RecordSet; FileName: string): boolean; // "" function CopyRecordSet(RecordSet: _RecordSet): _RecordSet; //, ( ) function UniqueTableName: string;
implementation
var FConnectionString, FSQL: string; FBatch: boolean;
constructor TThADOQuery.Create; begin inherited Create(True); FreeOnTerminate := True; end;
procedure TThADOQuery.Execute; begin CoInitializeEx(nil, COINIT_MULTITHREADED); // Query ADOQuery := TADOQuery.Create(nil); ADOQuery.CommandTimeout := 0; ADOQuery.ConnectionString := FConnectionString; // if Pos('FILE NAME=', AnsiUpperCase(FSQL)) = 1 then ADOQuery.SQL.LoadFromFile(Copy(FSQL, 11, Length(FSQL))) else ADOQuery.SQL.Text := FSQL; // try if FBatch then ADOQuery.LockType := ltBatchOptimistic else ADOQuery.LockType := ltOptimistic; ADOQuery.Open; except end; // Synchronize(DoWork); // Query ADOQuery.Close; ADOQuery.Free; CoUninitialize; end;
procedure TThADOQuery.DoWork; begin FAfterWork(Self.Handle, ADOQuery.Recordset, ADOQuery.Active); end;
constructor TThreadADOQuery.Create(aConnectionString: string); begin inherited Create; FActive := False; FConnectionString := aConnectionString; FHandle := 0; end;
procedure TThreadADOQuery.StartWork(aSQL: string; Batch: boolean = False); begin if not Assigned(Self) then exit; FActive := True; FQuery := TThADOQuery.Create; FHandle := FQuery.Handle; FQuery.OnAfterWork := AfterWork; FSQL := aSQL; FBatch := Batch; FQuery.ReSume; end;
procedure TThreadADOQuery.AfterWork(AHandle: THandle; RecordSet: _RecordSet; Active: Boolean); begin if Assigned(Self) and Assigned(FAfterWork) then FAfterWork(FHandle, Recordset, Active); FActive := False; end;
function TThreadADOQuery.PauseWork: boolean; begin if Assigned(Self) and FActive then FQuery.Suspended := not FQuery.Suspended; Result := FQuery.Suspended; end;
procedure TThreadADOQuery.StopWork; var c: Cardinal; begin c := 0; if Assigned(Self) and FActive then begin TerminateThread(FHandle, c); FQuery.ADOQuery.Free; FQuery.Free; end; FActive := False; end;
function RecordSetToTempTableForMSSQL(Connection: TADOConnection; RecordSet: _RecordSet; TableName: string): boolean; var i: integer; S, L: string; TempQuery: TADOQuery; begin Result := True; try S := '-- Script generated by Master BRAIN 2002 (C) --' + #13; S := S + 'IF OBJECT_ID(''TEMPDB..' + TableName + ''') IS NOT NULL DROP TABLE ' + TableName + #13; S := S + 'IF OBJECT_ID(''' + TableName + ''') IS NOT NULL DROP TABLE ' + TableName + #13; S := S + 'CREATE TABLE ' + TableName + ' (' + #13; for i := 0 to RecordSet.Fields.Count - 1 do begin case RecordSet.Fields.Item[i].Type_ of adSmallInt, adUnsignedSmallInt: L := 'SMALLINT'; adTinyInt, adUnsignedTinyInt: L := 'TINYINT'; adInteger, adUnsignedInt: L := 'INT'; adBigInt, adUnsignedBigInt: L := 'BIGINT'; adSingle, adDouble, adDecimal, adNumeric: L := 'NUMERIC(' + IntToStr(RecordSet.Fields.Item[i].Precision) + ',' + IntToStr(RecordSet.Fields.Item[i].NumericScale) + ')'; adCurrency: L := 'MONEY'; adBoolean: L := 'BIT'; adGUID: L := 'UNIQUEIDENTIFIER'; adDate, adDBDate, adDBTime, adDBTimeStamp: L := 'DATETIME'; adChar: L := 'CHAR(' + IntToStr(RecordSet.Fields.Item[i].DefinedSize) + ')'; adBSTR: L := 'NCHAR(' + IntToStr(RecordSet.Fields.Item[i].DefinedSize) + ')'; adVarChar: L := 'VARCHAR(' + IntToStr(RecordSet.Fields.Item[i].DefinedSize) + ')'; adVarWChar: L := 'NVARCHAR(' + IntToStr(RecordSet.Fields.Item[i].DefinedSize) + ')'; adLongVarChar: L := 'TEXT'; adLongVarWChar: L := 'NTEXT'; adBinary: L := 'BINARY(' + IntToStr(RecordSet.Fields.Item[i].DefinedSize) + ')'; adVarBinary: L := 'VARBINARY(' + IntToStr(RecordSet.Fields.Item[i].DefinedSize) + ')'; adLongVarBinary: L := 'IMAGE'; adFileTime, adDBFileTime: L := 'TIMESTAMP'; else L := 'SQL_VARIANT'; end; S := S + RecordSet.Fields.Item[i].Name + ' ' + L; if i < RecordSet.Fields.Count - 1 then S := S + ' ,' + #13 else S := S + ' )' + #13; end; S := S + 'SELECT * FROM ' + TableName + #13; TempQuery := TADOQuery.Create(nil); TempQuery.Close; TempQuery.LockType := ltBatchOptimistic; TempQuery.SQL.Text := S; TempQuery.Connection := Connection; TempQuery.Open; RecordSet.MoveFirst; while not RecordSet.EOF do begin TempQuery.Append; for i := 0 to RecordSet.Fields.Count - 1 do TempQuery.FieldValues[RecordSet.Fields[i].Name] := RecordSet.Fields[i].Value; TempQuery.Post; RecordSet.MoveNext; end; TempQuery.UpdateBatch; TempQuery.Close; except Result := False; end; end;
function RecordSetToDBF(RecordSet: _RecordSet; FileName: string): boolean; var F_sv: TextFile; i, j, s, sl, iRowCount, iColCount: integer; l: string; Fields: array of record FieldType: Char; FieldSize, FieldDigits: byte; end; FieldType, tmpDC: Char; FieldSize, FieldDigits: byte;
// - function Ansi2OEM(S: string): string; var Ansi_CODE, OEM_CODE: string; i: integer; begin OEM_CODE := ' '; Ansi_CODE := ''; Result := S; for i := 1 to Length(Result) do if Pos(Result[i], Ansi_CODE) > 0 then Result[i] := OEM_CODE[Pos(Result[i], Ansi_CODE)]; end;
begin Result := True; try AssignFile(F_sv, FileName); ReWrite(F_sv); iRowCount := RecordSet.RecordCount; iColCount := RecordSet.Fields.Count; // dBASE III 2.0 Write(F_sv, #3 + chr($63) + #4 + #4); // 4 write(F_sv, Chr((((iRowCount) mod 16777216) mod 65536) mod 256) + Chr((((iRowCount) mod 16777216) mod 65536) div 256) + Chr(((iRowCount) mod 16777216) div 65536) + Chr((iRowCount) div 16777216)); // Word32 -> - 5-8
i := (iColCount + 1) * 32 + 1; // write(F_sv, Chr(i mod 256) + Chr(i div 256)); // Word16 -> - 9-10
S := 1; // for i := 0 to iColCount - 1 do begin if RecordSet.Fields[i].Precision = 255 then Sl := RecordSet.Fields[i].DefinedSize else Sl := RecordSet.Fields[i].Precision; if RecordSet.Fields.Item[i].Type_ in [adDate, adDBDate, adDBTime, adFileTime, adDBFileTime, adDBTimeStamp] then Sl := 8; S := S + Sl; end;
write(F_sv, Chr(S mod 256) + Chr(S div 256)); { 11-12} for i := 1 to 17 do write(F_sv, #0); // - 20 write(F_sv, chr($26) + #0 + #0); // : 32 - DBF
SetLength(Fields, iColCount); for i := 0 to iColCount - 1 do begin // , l := Copy(RecordSet.Fields[i].Name, 1, 10); // while Length(l) < 11 do l := l + #0; write(F_sv, l); case RecordSet.Fields.Item[i].Type_ of adTinyInt, adSmallInt, adInteger, adBigInt, adUnsignedTinyInt, adUnsignedSmallInt, adUnsignedInt, adUnsignedBigInt, adDecimal, adNumeric, adVarNumeric, adSingle, adDouble: FieldType := 'N'; adCurrency: FieldType := 'F'; adDate, adDBDate, adDBTime, adFileTime, adDBFileTime, adDBTimeStamp: FieldType := 'D'; adBoolean: FieldType := 'L'; else FieldType := 'C'; end; Fields[i].FieldType := FieldType;
if RecordSet.Fields[i].Precision = 255 then FieldSize := RecordSet.Fields[i].DefinedSize else FieldSize := RecordSet.Fields[i].Precision;
if Fields[i].FieldType = 'D' then Fields[i].FieldSize := 8 else Fields[i].FieldSize := FieldSize;
if RecordSet.Fields[i].NumericScale = 255 then FieldDigits := 0 else FieldDigits := RecordSet.Fields[i].NumericScale; if (FieldType = 'F') and (FieldDigits < 2) then FieldDigits := 2; Fields[i].FieldDigits := FieldDigits;
write(F_sv, FieldType + #0 + #0 + #0 + #0); // write(F_sv, Chr(FieldSize) + Chr(FieldDigits)); write(F_sv, #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0); // 14 end; write(F_sv, Chr($0D)); //
tmpDC := DECIMALSEPARATOR; DECIMALSEPARATOR := '.'; // if iRowCount > 1 then RecordSet.MoveFirst; for j := 0 to iRowCount - 1 do begin // write(F_sv, ' '); for i := 0 to iColCount - 1 do begin case Fields[i].FieldType of 'D': if not VarIsNull(RecordSet.Fields[i].Value) then L := FormatDateTime('yyyymmdd', VarToDateTime(RecordSet.Fields[i].Value)) else L := '1900101'; 'N', 'F': if not VarIsNull(RecordSet.Fields[i].Value) then L := Format('%' + IntToStr(Fields[i].FieldSize - Fields[i].FieldDigits) + '.' + IntToStr(Fields[i].FieldDigits) + 'f', [StrToFloatDef(VarToStr(RecordSet.Fields[i].Value), 0)]) else L := ''; else if not VarIsNull(RecordSet.Fields[i].Value) then L := Ansi2Oem(VarToStr(RecordSet.Fields[i].Value)) else L := ''; end;
while Length(L) < Fields[i].FieldSize do if Fields[i].FieldType in ['N', 'F'] then L := L + #0 else L := L + ' '; if Length(L) > Fields[i].FieldSize then SetLength(L, Fields[i].FieldSize);
write(F_sv, l); end;
RecordSet.MoveNext; end; DECIMALSEPARATOR := tmpDC; write(F_sv, Chr($1A)); CloseFile(F_sv); except Result := False; if FileExists(FileName) then DeleteFile(FileName); end; end;
function CopyRecordSet(RecordSet: _RecordSet): _RecordSet; var adoStream: OleVariant; begin adoStream := CreateOLEObject('ADODB.Stream'); Variant(RecordSet).Save(adoStream, adPersistADTG); Result := CreateOLEObject('ADODB.RecordSet') as _RecordSet; Result.CursorLocation := adUseClient; Result.Open(adoStream, EmptyParam, adOpenStatic, adLockOptimistic, adOptionUnspecified); adoStream := UnAssigned; end;
function UniqueTableName: string; var G: TGUID; begin CreateGUID(G); Result := GUIDToString(G); Delete(Result, 1, 1); Delete(Result, Length(Result), 1); while Pos('-', Result) > 0 do Delete(Result, Pos('-', Result), 1); Result := 'T' + Result; end;
end. |
©Drkb::02874