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

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Delirium

WEB-сайт: http://delphibase.endimus.com

{ **** 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.

{/codecitation}

Добавить комментарий