Модуль, содержащий несколько удобств для работы с MSSQL посредством ADO

=== Модуль, содержащий несколько удобств для работы с MSSQL посредством ADO ===
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Модуль, содержащий несколько удобств для работы с MSSQL посредством ADO
Зависимости: Windows, Classes, SysUtils, ADODB, ADOInt, ActiveX, Controls, Variants, ComObj
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.
Author: Delirium
Source: http://delphibase.endimus.com
ID: 02874
Category:Базы данных
Category:MS SQL Server