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

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

{ **** UBPFD *********** by delphibase.endimus.com ****
>>
Зависимости: Windows, Classes, SysUtils, ADODB, ADOInt, ActiveX, Controls, Variants, ComObj
Автор: Delirium, <a href="mailto:Master_BRAIN@beep.ru">Master_BRAIN@beep.ru</a>, 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.Move;
  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.Move;
  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.

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...