adoquery.parameters流化-CSDN博客

unit WebAdoStream;

{****************************************************************

单元名称：WebAdoStream.pas

创建日期：2009-10-01

创建者本模块改编于 New Midas VCL Library(1.00)的JxStream.pas

功能:

当前版本：

Email：dcopyboy@tom.com

QQ:445235526

***************************************************************}

interface

uses Windows, Classes, SysUtils, SqlTimSt, FMTBcd, Variants, db, adodb;

type

// 存贮版本错误.

EPersistVersion = class(Exception);

EPersistError = class(Exception);

EClassNotFound = class(EPersistError);

EWriterError = class(EPersistError);

EReaderError = class(EPersistError);

// Unicode编码类型.

TStrTransferFormat = (tfUtf16LE, tfUtf16BE, tfUtf8);

// 数据写入(以小端格式写入)

TWAStreamWriter = class

private

FStream: TStream;

FTransferFormat: TStrTransferFormat; // 未用

procedure Write7BitEncodedInt(value: LongInt);

// 写入shortstring. 适用于写入ClassName, 因为这些属性以

// ShortString存在, 如果转换为String再写入, 则多了构造

// String的步骤, 速度较慢

procedure WriteShortString(const value: ShortString);

public

property Stream: TStream read FStream write FStream;

property TransferFormat: TStrTransferFormat read FTransferFormat write FTransferFormat;

procedure WriteBuffer(const Buffer; Count: Longint);

procedure WriteShortInt(value: ShortInt);

procedure WriteSmallInt(value: SmallInt);

procedure WriteLongInt(value: LongInt);

procedure WriteInt64(value: Int64);

procedure WriteByte(value: Byte);

procedure WriteWord(value: Word);

procedure WriteLongWord(value: LongWord);

procedure WriteCurrency(value: Currency);

procedure WriteSingle(value: Single);

procedure WriteDouble(value: Double);

procedure WriteBool(value: Boolean);

procedure WriteDateTime(value: TDateTime);

procedure WriteAscii(value: string);

procedure WriteString(value: string);

procedure WriteOleString(value: WideString);

procedure WriteBinary(const Buffer; Size: Integer);

procedure WriteTimeStamp(const ATimeStamp: TSqlTimeStamp);

procedure WriteFMTBcd(const ABcd: TBcd);

procedure WriteVariant(const V: Variant);

procedure WriteObjectProps(Obj: TPersistent);

end;

// 数据读取(以小端读取)

TWAStreamReader = class

private

FStream: TStream;

FTransferFormat: TStrTransferFormat;

function Read7BitEncodedInt: LongInt;

function ReadShortString: string;

public

property Stream: TStream read FStream write FStream;

property TransferFormat: TStrTransferFormat read FTransferFormat write FTransferFormat;

procedure ReadBuffer(var Buffer; Count: Longint);

function ReadShortInt: ShortInt;

function ReadSmallInt: SmallInt;

function ReadLongInt: LongInt;

function ReadInt64: Int64;

function ReadByte: Byte;

function ReadWord: Word;

function ReadLongWord: LongWord;

function ReadCurrency: Currency;

function ReadSingle: Single;

function ReadDouble: Double;

function ReadBool: Boolean;

function ReadDateTime: TDateTime;

// 读取ASCII字符串, 长度<=255, 多则截断.

function ReadAscii(len: Byte): string;

function ReadString: string;

function ReadOleString: WideString;

function ReadBinary: string;

function ReadStream: TStream;

procedure ReadTimeStamp(var ATimeStamp: TSqlTimeStamp);

procedure ReadFMTBcd(var ABcd: TBcd);

function ReadVariant: Variant;

procedure ReadObjectProps(Obj: TPersistent);

end;

function AdoQuerySaveTostream(Adoq: Tadoquery): TMemoryStream;

function AdoQueryLoadFromstream(Adoq: Tadoquery; Stream: TMemoryStream): boolean;

implementation

uses TypInfo;

resourcestring

SInvalidVariantType = '无效的Variant类型 %d';

SClassNotFound = 'class %s not found.';

SWriterError = 'Stream write error.';

SReaderError = 'Stream read error.';

SPersistClassError = 'Persistable class not supported.';

SPersistTypeNotSupported = 'Type %s not supported';

type

PIntArray = ^TIntArray;

TIntArray = array[0..0] of Integer;

const

SimpleArrayTypes = [varSmallInt, varInteger, varSingle, varDouble, varCurrency,

varDate, varBoolean, varShortInt, varByte, varWord, varLongWord];

VariantSize: array[0..varLongWord] of Word = (0, 0, SizeOf(SmallInt), SizeOf(Integer),

SizeOf(Single), SizeOf(Double), SizeOf(Currency), SizeOf(TDateTime), 0, 0,

SizeOf(Integer), SizeOf(WordBool), 0, 0, 0, 0, SizeOf(ShortInt), SizeOf(Byte),

SizeOf(Word), SizeOf(LongWord));

CMinVarType = $100;

StreamFMTBcdID = CMinVarType + 1;

StreamSQLTimeStampID = CMinVarType + 2;

{ TWAStreamWriter }

procedure TWAStreamWriter.Write7BitEncodedInt(value: Integer);

begin

while value > $80 do

begin

WriteByte(Byte(value or $80));

value := value shr 7;

end;

WriteByte(value and $FF);

end;

procedure TWAStreamWriter.WriteAscii(value: string);

var

len: Integer;

begin

len := Length(value);

if len > 255 then

len := 255;

if len > 0 then WriteBuffer(PChar(value)^, len);

end;

procedure TWAStreamWriter.WriteBinary(const Buffer; Size: Integer);

begin

Write7BitEncodedInt(Size);

WriteBuffer(Buffer, Size);

end;

procedure TWAStreamWriter.WriteBool(value: Boolean);

begin

if value then

WriteByte(1)

else

WriteByte(0);

end;

procedure TWAStreamWriter.WriteBuffer(const Buffer; Count: Integer);

begin

if (Count <> 0) and (Stream.Write(Buffer, Count) <> Count) then

raise EWriterError.Create(SWriterError);

end;

procedure TWAStreamWriter.WriteByte(value: Byte);

begin

WriteBuffer(value, 1);

end;

procedure TWAStreamWriter.WriteCurrency(value: Currency);

begin

// h2n_Data8(value);

WriteBuffer(value, SizeOf(value));

end;

procedure TWAStreamWriter.WriteDateTime(value: TDateTime);

begin

// h2n_Data8(value);

WriteBuffer(value, SizeOf(value));

end;

procedure TWAStreamWriter.WriteDouble(value: Double);

begin

// h2n_Data8(value);

WriteBuffer(value, SizeOf(value));

end;

procedure TWAStreamWriter.WriteFMTBcd(const ABcd: TBcd);

begin

with ABcd do

begin

WriteByte(Precision);

WriteByte(SignSpecialPlaces);

WriteBuffer(Fraction, SizeOf(Fraction));

end;

procedure TWAStreamWriter.WriteInt64(value: Int64);

begin

// h2n_Data8(value);

WriteBuffer(value, SizeOf(value));

end;

procedure TWAStreamWriter.WriteLongInt(value: Integer);

begin

// h2n_Data4(value);

WriteBuffer(value, SizeOf(value));

end;

procedure TWAStreamWriter.WriteLongWord(value: LongWord);

begin

// h2n_Data4(value);

WriteBuffer(value, SizeOf(value));

end;

procedure TWAStreamWriter.WriteObjectProps(Obj: TPersistent);

procedure WriteCollection(Coll: TCollection);

var

I: Integer;

begin

WriteObjectProps(Coll);

WriteLongInt(Coll.Count);

for I := 0 to Coll.Count - 1 do

WriteObjectProps(Coll.Items[I]);

end;

var

TypData: PTypeData;

PropCount, I, OrdVal: Integer;

Int64Val: Int64;

DblVal: Double;

StrVal: string;

ObjVal: TObject;

WVal: WideString;

VarVal: Variant;

Props: PPropList;

PropInfo: PPropInfo;

begin

TypData := GetTypeData(Obj.ClassInfo);

if TypData <> nil then

begin

PropCount := TypData.PropCount;

if PropCount > 0 then

begin

GetMem(Props, PropCount * SizeOf(PPropInfo));

try

PropCount := GetPropList(PTypeInfo(Obj.ClassInfo), tkProperties, Props);

for I := 0 to PropCount - 1 do

begin

PropInfo := Props^[I];

with PropInfo^ do

begin

case PropType^.Kind of

tkInteger:

begin

OrdVal := GetOrdProp(Obj, PropInfo);

WriteLongInt(OrdVal);

// case GetTypeData(PropType^).OrdType of

// otSByte, otUByte: WriteByte(OrdVal);

// otSWord, otUWord: WriteWord(OrdVal);

// otSLong, otULong: WriteLongInt(OrdVal);

// end;

end;

tkInt64:

begin

Int64Val := GetInt64Prop(Obj, PropInfo);

WriteInt64(Int64Val);

end;

tkEnumeration:

begin

OrdVal := GetOrdProp(Obj, PropInfo);

WriteByte(OrdVal);

end;

tkFloat:

begin

DblVal := GetFloatProp(Obj, PropInfo);

WriteDouble(DblVal);

end;

tkLString,

tkString:

begin

StrVal := GetStrProp(Obj, PropInfo);

WriteString(StrVal);

end;

tkWString:

begin

WVal := GetWideStrProp(Obj, PropInfo);

WriteOleString(WVal);

end;

tkClass:

begin

ObjVal := GetObjectProp(Obj, PropInfo);

if ObjVal is TStrings then

WriteString(TStrings(ObjVal).CommaText)

else if ObjVal is TCollection then

WriteCollection(TCollection(ObjVal))

else if ObjVal is TPersistent then

WriteObjectProps(TPersistent(ObjVal))

else

raise EPersistError.Create(SPersistClassError);

end;

tkSet:

begin

OrdVal := GetOrdProp(Obj, PropInfo);

WriteLongInt(OrdVal);

end;

tkChar:

begin

OrdVal := GetOrdProp(Obj, PropInfo);

WriteByte(OrdVal);

end;

tkWChar:

begin

OrdVal := GetOrdProp(Obj, PropInfo);

WriteSmallInt(OrdVal);

end;

tkVariant:

begin

VarVal := TypInfo.GetVariantProp(Obj, PropInfo);

WriteVariant(VarVal);

end;

tkDynArray:

begin

TypData := GetTypeData(PropInfo.PropType^);

assert(TypData <> nil);

end;

else

raise EPersistError.CreateFmt(SPersistTypeNotSupported,

[GetEnumName(TypeInfo(TTypeKind), Ord(PropInfo.PropType^.Kind))]);

{

tkArray,

tkRecord,

tkMethod,

tkInterface,

tkDynArray

}

end; // case

end; // with

end; // for

finally

FreeMem(Props, PropCount * SizeOf(PPropInfo));

end;

procedure TWAStreamWriter.WriteOleString(value: WideString);

var

S: string;

len: Integer;

begin

S := Utf8Encode(value);

len := Length(S);

Write7BitEncodedInt(len);

if len > 0 then

WriteBuffer(PChar(S)^, len);

end;

procedure TWAStreamWriter.WriteShortInt(value: ShortInt);

begin

WriteBuffer(value, SizeOf(value));

end;

procedure TWAStreamWriter.WriteShortString(const value: ShortString);

begin

WriteByte(Length(value));

WriteBuffer(value[1], Length(value));

end;

procedure TWAStreamWriter.WriteSingle(value: Single);

begin

// h2n_Data4(value);

WriteBuffer(value, SizeOf(value));

end;

procedure TWAStreamWriter.WriteSmallInt(value: SmallInt);

begin

// value := Word(h2n_Word(Word(value)));

WriteBuffer(value, SizeOf(value));

end;

procedure TWAStreamWriter.WriteString(value: string);

var

S: string;

len: Integer;

begin

S := AnsiToUtf8(value);

len := Length(S);

Write7BitEncodedInt(len);

if len > 0 then

WriteBuffer(PChar(S)^, len);

end;

procedure TWAStreamWriter.WriteTimeStamp(const ATimeStamp: TSqlTimeStamp);

begin

with ATimeStamp do

begin

WriteSmallInt(Year);

WriteWord(Month);

WriteWord(Day);

WriteWord(Hour);

WriteWord(Minute);

WriteWord(Second);

WriteLongWord(Fractions);

end;

procedure TWAStreamWriter.WriteVariant(const V: Variant);

procedure WriteArray(const V: Variant);

var

VType: Word;

VSize, DimCount, I, ElemSize: Integer;

LoDim, HiDim: PIntArray;

Indices: array of Integer;

P: Pointer;

V2: Variant;

begin

VType := VarType(V) and varTypeMask;

DimCount := VarArrayDimCount(V);

VSize := SizeOf(Integer) * DimCount;

GetMem(LoDim, VSize);

GetMem(HiDim, VSize);

try

for I := 1 to DimCount do

begin

LoDim[I - 1] := VarArrayLowBound(V, I);

HiDim[I - 1] := VarArrayHighBound(V, I);

end;

WriteWord(VType or varArray);

WriteWord(DimCount);

WriteBuffer(LoDim^, VSize);

WriteBuffer(HiDim^, VSize);

if VType in SimpleArrayTypes then

begin

ElemSize := VariantSize[VType];

Assert(ElemSize <> 0);

VSize := 1;

for I := 0 to DimCount - 1 do

VSize := (HiDim[I] - LoDim[I] + 1) * VSize;

VSize := VSize * ElemSize;

P := VarArrayLock(V);

try

WriteLongInt(VSize);

WriteBuffer(P^, VSize);

finally

VarArrayUnlock(V);

end;

end

else

begin

SetLength(Indices, DimCount);

for I := 0 to DimCount - 1 do

Indices[I] := LoDim[I];

while True do

begin

V2 := VarArrayGet(V, Indices);

WriteVariant(V2);

Inc(Indices[DimCount - 1]);

if Indices[DimCount - 1] > HiDim[DimCount - 1] then

for i := DimCount - 1 downto 0 do

if Indices[i] > HiDim[i] then

begin

if i = 0 then Exit;

Inc(Indices[i - 1]);

Indices[i] := LoDim[i];

end;

finally

FreeMem(LoDim);

FreeMem(HiDim);

end;

var

VType: Word;

W: WideString;

begin

VType := VarType(V);

if (VType and varArray) <> 0 then

WriteArray(V)

else

case VType and varTypeMask of

varEmpty, varNull:

begin

WriteWord(VType);

end;

varString:

begin

WriteWord(VType and varTypeMask);

WriteString(V);

end;

varOleStr:

begin

WriteWord(VType and varTypeMask);

W := V;

WriteOleString(W);

end;

varVariant:

begin

if VType and varByRef <> varByRef then

raise EWriteError.CreateFmt(SInvalidVariantType, [VType]);

WriteVariant(Variant(TVarData(V).VPointer^));

end;

else begin

if VarIsFMTBcd(V) then

begin

WriteWord(StreamFMTBcdID);

WriteFMTBcd(VarToBcd(V));

end

else if VarIsSQLTimeStamp(V) then

begin

WriteWord(StreamSQLTimeStampID);

WriteTimeStamp(VarToSQLTimeStamp(V));

end

else begin

WriteWord(VType and varTypeMask);

case VType and varTypeMask of

varSmallint: WriteSmallInt(V);

varInteger: WriteLongInt(V);

varSingle: WriteSingle(V);

varDouble: WriteDouble(V);

varCurrency: WriteCurrency(V);

varDate: WriteDateTime(V);

varError: WriteLongInt(V);

varBoolean: WriteBool(V);

varShortInt: WriteShortInt(V);

varByte: WriteByte(V);

varWord: WriteWord(V);

varLongWord: WriteLongWord(V);

varInt64: WriteInt64(V);

else

raise EWriteError.CreateFmt(SInvalidVariantType, [VType]);

end;

procedure TWAStreamWriter.WriteWord(value: Word);

begin

// value := h2n_Word(value);

WriteBuffer(value, SizeOf(value));

end;

{ TWAStreamReader }

function TWAStreamReader.Read7BitEncodedInt: LongInt;

var

n: Byte;

offset: Integer;

begin

offset := 0;

Result := 0;

repeat

n := ReadByte;

Result := Result or ((n and $7F) shl offset);

Inc(offset, 7);

until (n and $80) = 0;

end;

function TWAStreamReader.ReadAscii(len: Byte): string;

begin

if len > 0 then

begin

SetLength(Result, len);

ReadBuffer(PChar(Result)^, len);

end

else

Result := '';

end;

function TWAStreamReader.ReadBinary: string;

var

Len: Integer;

begin

Len := Read7BitEncodedInt;

SetLength(Result, Len);

ReadBuffer(PChar(Result)^, Len);

end;

function TWAStreamReader.ReadStream: Tstream;

var

Len: Integer;

begin

Len := Read7BitEncodedInt;

Result := Tstream.Create;

ReadBuffer(Result, Len);

end;

function TWAStreamReader.ReadBool: Boolean;

begin

Result := (ReadByte <> 0);

end;

procedure TWAStreamReader.ReadBuffer(var Buffer; Count: Integer);

begin

if (Count <> 0) and (Stream.Read(Buffer, Count) <> Count) then

raise EReaderError.Create(SReaderError);

end;

function TWAStreamReader.ReadByte: Byte;

begin

ReadBuffer(Result, 1);

end;

function TWAStreamReader.ReadCurrency: Currency;

begin

ReadBuffer(Result, SizeOf(Currency));

end;

function TWAStreamReader.ReadDateTime: TDateTime;

begin

ReadBuffer(Result, SizeOf(TDateTime));

end;

function TWAStreamReader.ReadDouble: Double;

begin

ReadBuffer(Result, SizeOf(Double));

end;

procedure TWAStreamReader.ReadFMTBcd(var ABcd: TBcd);

begin

with ABcd do

begin

Precision := ReadByte;

SignSpecialPlaces := ReadByte;

ReadBuffer(Fraction, SizeOf(Fraction));

end;

function TWAStreamReader.ReadInt64: Int64;

begin

ReadBuffer(Result, SizeOf(Int64));

end;

function TWAStreamReader.ReadLongInt: LongInt;

begin

ReadBuffer(Result, SizeOf(LongInt));

end;

function TWAStreamReader.ReadLongWord: LongWord;

begin

ReadBuffer(Result, SizeOf(LongWord));

end;

procedure TWAStreamReader.ReadObjectProps(Obj: TPersistent);

procedure ReadCollection(Coll: TCollection);

var

I, Len: Integer;

Item: TCollectionItem;

begin

ReadObjectProps(Coll);

Len := ReadLongInt;

for I := 0 to Len - 1 do

begin

Item := Coll.Add;

ReadObjectProps(Item);

end;

var

TypData: PTypeData;

PropCount, I, OrdVal: Integer;

Props: PPropList;

Int64Val: Int64;

DblVal: Double;

StrVal: string;

ObjVal: TObject;

WVal: WideString;

VarVal: Variant;

PropInfo: PPropInfo;

begin

TypData := GetTypeData(Obj.ClassInfo);

if TypData <> nil then

begin

PropCount := TypData.PropCount;

if PropCount > 0 then

begin

GetMem(Props, PropCount * SizeOf(PPropInfo));

try

PropCount := GetPropList(PTypeInfo(Obj.ClassInfo), tkProperties, Props);

for I := 0 to PropCount - 1 do

begin

PropInfo := Props^[I];

with PropInfo^ do

begin

case PropType^.Kind of

tkInteger:

begin

OrdVal := ReadLongInt;

SetOrdProp(Obj, PropInfo, OrdVal);

end;

tkInt64:

begin

Int64Val := ReadInt64;

SetInt64Prop(Obj, PropInfo, Int64Val);

end;

tkEnumeration:

begin

OrdVal := ReadByte;

SetOrdProp(Obj, PropInfo, OrdVal);

end;

tkFloat:

begin

DblVal := ReadDouble;

SetFloatProp(Obj, PropInfo, DblVal);

end;

tkLString,

tkString:

begin

StrVal := ReadString;

SetStrProp(Obj, PropInfo, StrVal);

end;

tkWString:

begin

WVal := ReadOleString;

SetWideStrProp(Obj, PropInfo, WVal);

end;

tkClass:

begin

ObjVal := GetObjectProp(Obj, PropInfo);

if not (ObjVal is TPersistent) then

raise EPersistError.Create(SPersistClassError);

if ObjVal is TStrings then

begin

StrVal := ReadString;

TStrings(ObjVal).CommaText := StrVal;

end

else if ObjVal is TCollection then

ReadCollection(TCollection(ObjVal))

else

ReadObjectProps(TPersistent(ObjVal));

end;

tkSet:

begin

OrdVal := ReadLongint;

SetOrdProp(Obj, PropInfo, OrdVal);

end;

tkChar:

begin

OrdVal := ReadByte;

SetOrdProp(Obj, PropInfo, OrdVal);

end;

tkWChar:

begin

OrdVal := ReadSmallInt;

SetOrdProp(Obj, PropInfo, OrdVal);

end;

tkVariant:

begin

VarVal := ReadVariant;

SetVariantProp(Obj, PropInfo, VarVal);

end;

else

raise EPersistError.CreateFmt(SPersistTypeNotSupported,

[GetEnumName(TypeInfo(TTypeKind), Ord(PropInfo.PropType^.Kind))]);

end; // case

end; // with

end; // for

finally

FreeMem(Props, PropCount * SizeOf(PPropInfo));

end;

function TWAStreamReader.ReadOleString: WideString;

var

len: Integer;

s: string;

begin

len := Read7BitEncodedInt;

if len > 0 then

begin

SetLength(s, len);

ReadBuffer(PChar(s)^, len);

Result := Utf8Decode(s);

end

else

begin

Result := '';

end;

function TWAStreamReader.ReadShortInt: ShortInt;

begin

ReadBuffer(Result, SizeOf(ShortInt));

end;

function TWAStreamReader.ReadShortString: string;

var

Len: Integer;

begin

Result := '';

Len := ReadByte;

if Len = 0 then Exit;

SetLength(Result, Len);

ReadBuffer(PChar(Result)^, Len);

end;

function TWAStreamReader.ReadSingle: Single;

begin

ReadBuffer(Result, SizeOf(Single));

end;

function TWAStreamReader.ReadSmallInt: SmallInt;

begin

ReadBuffer(Result, SizeOf(SmallInt));

end;

function TWAStreamReader.ReadString: string;

begin

Result := ReadOleString;

end;

procedure TWAStreamReader.ReadTimeStamp(var ATimeStamp: TSqlTimeStamp);

begin

with ATimeStamp do

begin

Year := ReadSmallInt;

Month := ReadWord;

Day := ReadWord;

Hour := ReadWord;

Minute := ReadWord;

Second := ReadWord;

Fractions := ReadLongWord;

end;

function TWAStreamReader.ReadVariant: Variant;

procedure ReadArray(VType: Word; var V: Variant);

var

DimCount: Word;

VSize, I: Integer;

LoDim, HiDim, Bounds, Indices: array of Integer;

P: Pointer;

V2: Variant;

begin

VType := VType and varTypeMask;

DimCount := ReadWord;

VSize := DimCount * SizeOf(Integer);

SetLength(LoDim, DimCount);

SetLength(HiDim, DimCount);

SetLength(Bounds, DimCount * 2);

ReadBuffer(LoDim[0], VSize);

ReadBuffer(HiDim[0], VSize);

for I := 0 to DimCount - 1 do

begin

Bounds[I * 2] := LoDim[I];

Bounds[I * 2 + 1] := HiDim[I];

end;

V := VarArrayCreate(Bounds, VType);

if VType in SimpleArrayTypes then

begin

VSize := ReadLongInt;

P := VarArrayLock(V);

try

ReadBuffer(P^, VSize);

finally

VarArrayUnlock(V);

end;

end

else

begin

SetLength(Indices, DimCount);

for I := 0 to DimCount - 1 do

Indices[I] := LoDim[I];

while True do

begin

V2 := ReadVariant;

VarArrayPut(V, V2, Indices);

Inc(Indices[DimCount - 1]);

if Indices[DimCount - 1] > HiDim[DimCount - 1] then

for i := DimCount - 1 downto 0 do

if Indices[i] > HiDim[i] then

begin

if i = 0 then Exit;

Inc(Indices[i - 1]);

Indices[i] := LoDim[i];

end;

var

VType: Word;

ABcd: TBcd;

ATimeStamp: TSQLTimeStamp;

begin

VType := ReadWord;

if VType and varArray <> 0 then

ReadArray(VType, Result)

else

case VType of

varEmpty: VarClear(Result);

varNull: Result := Null;

varString: Result := ReadString;

varOleStr: Result := ReadOleString;

varVariant: Result := ReadVariant;

varSmallint: Result := ReadSmallint;

varInteger: Result := ReadLongInt;

varSingle: Result := ReadSingle;

varDouble: Result := ReadDouble;

varCurrency: Result := ReadCurrency;

varDate: Result := ReadDateTime;

varError:

begin

Result := ReadLongInt;

TVarData(Result).VType := varError;

end;

varBoolean: Result := ReadBool;

varShortInt: Result := ReadShortInt;

varByte: Result := ReadByte;

varWord: Result := ReadWord;

varLongWord: Result := ReadLongWord;

varInt64: Result := ReadInt64;

else

if VType = StreamFMTBcdID then

begin

Self.ReadFMTBcd(ABcd);

Result := VarFMTBcdCreate(ABcd);

end

else if VType = StreamSQLTimeStampID then

begin

ReadTimeStamp(ATimeStamp);

Result := VarSQLTimeStampCreate(ATimeStamp);

end

else

raise EReadError.CreateFmt(SInvalidVariantType, [VType]);

end;

function TWAStreamReader.ReadWord: Word;

begin

ReadBuffer(Result, SizeOf(Word));

end;

//下列2个过程由Dcopyboy编写

function AdoQuerySaveTostream(Adoq: Tadoquery): TMemoryStream;

var

aa: TWAStreamWriter;

i, b: integer;

Stream: TMemoryStream;

begin

aa := TWAStreamWriter.Create;

aa.Stream := TMemoryStream.Create;

aa.WriteString(Adoq.SQL.Text);

b := Adoq.Parameters.Count;

aa.WriteSmallInt(b);

for i := 0 to b - 1 do begin

aa.WriteString(adoq.Parameters[i].Name);

if adoq.Parameters[i].DataType = ftGraphic then begin

aa.WriteByte(250);

aa.WriteVariant(adoq.Parameters[i].Value);

end

else if adoq.Parameters[i].DataType = ftMemo then begin

aa.WriteByte(249);

aa.WriteVariant(adoq.Parameters[i].Value);

end

else if adoq.Parameters[i].DataType = ftFmtMemo then begin

aa.WriteByte(248);

aa.WriteVariant(adoq.Parameters[i].Value);

end

else if adoq.Parameters[i].DataType = ftblob then begin

aa.WriteByte(247);

aa.WriteVariant(adoq.Parameters[i].Value);

end

else begin

aa.WriteByte(1);

aa.WriteVariant(adoq.Parameters[i].Value);

end;

Result := TMemoryStream(aa.Stream);

aa.Free;

end;

function AdoQueryLoadFromstream(Adoq: Tadoquery; Stream: TMemoryStream): boolean;

var

aa: TWAStreamReader;

i, b: integer;

Stream1: TMemoryStream;

PName: string;

Ptype: word;

MyValue: Variant;

begin

aa := TWAStreamReader.Create;

aa.Stream := TMemoryStream.Create;

Stream.Position := 0;

TMemoryStream(aa.Stream).LoadFromStream(stream);

Adoq.Close;

aa.Stream.Position := 0;

adoq.SQL.Text := aa.ReadString;

b := aa.ReadSmallInt;

for i := 0 to b - 1 do begin

PName := aa.ReadString;

Ptype := aa.ReadByte;

if ptype = 250 then begin

adoq.Parameters.ParamByName(Pname).DataType := ftGraphic;

adoq.Parameters.ParamByName(Pname).Value := aa.ReadVariant;

adoq.Parameters.ParamByName(Pname).DataType := ftGraphic;

end

else if ptype = 249 then begin

adoq.Parameters.ParamByName(Pname).DataType := ftMemo;

adoq.Parameters.ParamByName(Pname).Value := aa.ReadVariant;

adoq.Parameters.ParamByName(Pname).DataType := ftMemo;

end

else if ptype = 248 then begin

adoq.Parameters.ParamByName(Pname).DataType := ftFmtMemo;

adoq.Parameters.ParamByName(Pname).Value := aa.ReadVariant;

adoq.Parameters.ParamByName(Pname).DataType := ftFmtMemo;

end

else if ptype = 247 then begin

adoq.Parameters.ParamByName(Pname).DataType := ftblob;

adoq.Parameters.ParamByName(Pname).Value := aa.ReadVariant;

adoq.Parameters.ParamByName(Pname).DataType := ftblob;

end

else begin

adoq.Parameters.ParamByName(Pname).Value := aa.ReadVariant;

end;

aa.Free;

Result := true;

end;

end.

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, WebAdoStream, DB, ADODB, ExtCtrls, ComCtrls, jpeg;

type

TForm1 = class(TForm)

Button1: TButton;

ADOConnection1: TADOConnection;

ADOQuery1: TADOQuery;

RichEdit1: TRichEdit;

Image1: TImage;

Button2: TButton;

Button3: TButton;

Button4: TButton;

Button5: TButton;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure Button4Click(Sender: TObject);

procedure Button5Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

{

//测试用表：

CREATE TABLE [dbo].[test] (

[f1] [float] NULL ,

[f2] [int] NULL ,

[f3] [money] NULL ,

[f4] [numeric](18, 0) NULL ,

[f5] [real] NULL ,

[d1] [datetime] NULL ,

[c1] [char] (10) NULL ,

[c2] [varchar] (50) NULL ,

[b1] [ntext] NULL ,

[b2] [text] NULL ,

[b3] [image] NULL ,

[B4] [image] NULL ,

[id] [int] IDENTITY (1, 1) NOT NULL

) ON [PRIMARY] TEXTIMAGE_ON [PRIMARY]

}

procedure TForm1.Button1Click(Sender: TObject);

var

Stream1: TMemoryStream;

begin

ADOQuery1.Close;

ADOQuery1.SQL.Text := 'Insert into test ( f1,f2,f3,f4,f5,d1,c1,c2,b1,b2,b3,b4) ' +

' values ( :f1,:f2,:f3,:f4,:f5,:d1,:c1,:c2,:b1,:b2,:b3,:b4) ';

ADOQuery1.Parameters.ParamByName('f1').Value := 10;

ADOQuery1.Parameters.ParamByName('f2').Value := 20;

ADOQuery1.Parameters.ParamByName('f3').Value := 30;

ADOQuery1.Parameters.ParamByName('f4').Value := 40;

ADOQuery1.Parameters.ParamByName('f5').Value := 50;

ADOQuery1.Parameters.ParamByName('d1').Value := now();

ADOQuery1.Parameters.ParamByName('c1').Value := '字段1';

ADOQuery1.Parameters.ParamByName('c2').Value := '字段2';

ADOQuery1.Parameters.ParamByName('b1').LoadFromFile('本草纲目.txt', ftMemo);

ADOQuery1.Parameters.ParamByName('b2').LoadFromFile('本草纲目.txt', ftMemo);

ADOQuery1.Parameters.ParamByName('b3').LoadFromFile('东阳.jpg', ftblob);

ADOQuery1.Parameters.ParamByName('b4').LoadFromFile('东阳.jpg', ftGraphic);

Stream1 := TMemoryStream.Create;

Stream1.LoadFromStream(AdoQuerySaveTostream(ADOQuery1));

stream1.SaveToFile('c:/parastreamtest');

Stream1.Free;

Stream1 := TMemoryStream.Create;

stream1.LoadFromFile('c:/parastreamtest');

ADOQuery1.Close;

ADOQuery1.sql.clear;

AdoQueryLoadFromstream(ADOQuery1, Stream1);

ADOQuery1.ExecSQL;

Stream1.Free;

end;

procedure TForm1.Button2Click(Sender: TObject);

var

Stream1: TMemoryStream;

begin

RichEdit1.Lines.Clear;

ADOQuery1.Close;

ADOQuery1.SQL.Text := 'select b1 from test ';

ADOQuery1.open;

Stream1 := TMemoryStream.Create;

Tmemofield(ADOQuery1.FieldByName('b1')).SaveToStream(stream1);

stream1.Position := 0;

RichEdit1.Lines.LoadFromStream(stream1);

stream1.free;

end;

procedure TForm1.Button3Click(Sender: TObject);

var

Stream1: TMemoryStream;

begin

RichEdit1.Lines.Clear;

ADOQuery1.Close;

ADOQuery1.SQL.Text := 'select b2 from test ';

ADOQuery1.open;

Stream1 := TMemoryStream.Create;

Tmemofield(ADOQuery1.FieldByName('b2')).SaveToStream(stream1);

stream1.Position := 0;

RichEdit1.Lines.LoadFromStream(stream1);

stream1.free;

end;

procedure TForm1.Button4Click(Sender: TObject);

var

Stream1: TMemoryStream;

Jpeg1: TJPEGImage;

begin

ADOQuery1.Close;

ADOQuery1.SQL.Text := 'select b3 from test ';

ADOQuery1.open;

Stream1 := TMemoryStream.Create;

Tblobfield(ADOQuery1.FieldByName('b3')).SaveToStream(stream1);

stream1.Position := 0;

Jpeg1 := TJPEGImage.Create;

Jpeg1.LoadFromStream(stream1);

stream1.free;

Image1.Picture.Assign(jpeg1);

jpeg1.Free;

end;

procedure TForm1.Button5Click(Sender: TObject);

var

Stream1: TMemoryStream;

Jpeg1: TJPEGImage;

begin

ADOQuery1.Close;

ADOQuery1.SQL.Text := 'select b4 from test ';

ADOQuery1.open;

Stream1 := TMemoryStream.Create;

Tblobfield(ADOQuery1.FieldByName('b4')).SaveToStream(stream1);

stream1.Position := 0;

Jpeg1 := TJPEGImage.Create;

Jpeg1.LoadFromStream(stream1);

stream1.free;

Image1.Picture.Assign(jpeg1);

jpeg1.Free;

end;

end.

adoquery.parameters流化

“相关推荐”对你有帮助么？