Mega Code Archive
Bde fonksiyonları 16
<![CDATA[
Encode Hour, Minute, and Seconds into a TIME variable.
This example uses the following input:
fDbiTimeEncode(4,20,42, MyTime);
The procedure is:
procedure fDbiTimeEncode(iHour: Word; iMin: Word; iSec: Word; var TimeT: Time);
begin
if (iSec > 59) then
Check(dbiErr_InvalidTime);
iSec := iSec * 1000;
Check(DbiTimeEncode(iHour, iMin, iSec, TimeT));
end;
//*********************************************************************************
Decode a TimeStamp variable into a string including all information
This example uses the following input:
fDbiTimeStampDecode(TS, Buffer);
The function is:
function fDbiTimeStampDecode(timestampTS: TimeStamp): string;
var
DateVar: dbiDATE;
TimeVar: TIME;
hour, min, millsec, Month, Day: Word;
Year: SmallInt;
begin
SetLength(Result, 100);
Check(DbiTimeStampDecode(timestampTS, DateVar, TimeVar));
Check(DbiTimeDecode(TimeVar, hour, min, millsec));
Check(DbiDateDecode(DateVar, Month, Day, Year));
if (hour > 12) then
Result := Format('Time: %d:%d:%d PM, Date: %d/%d/%d',
[hour - 12, min, millsec div 1000, Month, Day, Year])
else
Result := Format('Time: %d:%d:%d AM, Date: %d/%d/%d',
[hour, min, millsec div 1000, Month, Day, Year]);
SetLength(Result, StrLen(PChar(Result)));
end;
//************************************************************************************
Encode a TimeStamp variable from a DBIDATE and TIME variable.
This example uses the following input:
fDbiTimeStampEncode(MyDate, MyTime, TS);
The procedure is:
procedure fDbiTimeStampEncode(ADate: dbiDate; timeT: TIME; var timestampTS: TimeStamp);
begin
Check(DbiTimeStampEncode(ADate, timeT, timestampTS));
end;
//************************************************************************************
Creates an empty version of SrcTbl to DestTbl. This will convert from any source type to any destination type--Paradox to InterBase and so on. The Table does not have any indexes.
This example uses the following input:
fDbiTranslateRecordStructure(AnimalTbl, NewTbl, AnimalTbl.DBHandle);
The procedure is:
procedure fDbiTranslateRecordStructure(SrcTbl, DestTbl: TTable; DestDB: hDBIDb);
var
pSrcFlds, pDestFlds: pFLDDesc;
TblDesc: CRTblDesc;
DBType: string;
W: Word;
begin
pSrcFlds := AllocMem(SrcTbl.FieldCount * sizeof(FLDDesc));
pDestFlds := AllocMem(SrcTbl.FieldCount * sizeof(FLDDesc));
try
SetLength(DBType, DBIMAXNAMELEN);
// Get the destination database type
Check(DbiGetProp(hDBIObj(DestDb), dbDATABASETYPE,
PChar(DBType), DBIMAXNAMELEN, W));
SetLength(DBType, StrLen(PChar(DBType)));
if (DBType = 'STANDARD') then begin
if (UpperCase(ExtractFileExt(DestTbl.TableName)) = '.DB') then
DBType := szParadox
else if (UpperCase(ExtractFileExt(DestTbl.TableName)) = '.DBF') then
DBType := szDbase
else if (UpperCase(ExtractFileExt(DestTbl.TableName)) = '.') then
DBType := szParadox
else
raise EDBEngineError.Create(DBIERR_UNKNOWNDRIVER);
end;
// Get the source field information
Check(DbiGetFieldDescs(SrcTbl.Handle, pSrcFlds));
// Translate the source fields into the destination fields
Check(DbiTranslateRecordStructure(nil, SrcTbl.FieldCount, pSrcFlds,
PChar(DBType), nil, pDestFlds, False));
FillChar(TblDesc, sizeof(TblDesc), #0);
StrPCopy(TblDesc.szTblName, DestTbl.TableName);
StrPCopy(TblDesc.szTblType, DBType);
TblDesc.iFldCount := SrcTbl.FieldCount;
TblDesc.pFldDesc := pDestFlds;
// Create the destination table
Check(DbiCreateTable(DestDB, True, TblDesc));
finally
FreeMem(pSrcFlds, SrcTbl.FieldCount * sizeof(FLDDesc));
FreeMem(pDestFlds, SrcTbl.FieldCount * sizeof(FLDDesc));
end;
end;
//************************************************************************************
Truncate all BLOBs in the specified field to zero. If any error occurs while removing BLOB information, stop at that record.
This example uses the following input:
fDbiTruncateBlob(BiotestTbl, BiotestTbl.FieldByName('Notes').Index);
The procedure is:
procedure fDbiTruncateBlob(BlobTbl: TTable; Index: Word);
var
hCur: hDBICur;
pRecBuf: pBYTE;
begin
hCur := nil;
// Make sure the field specified is a BLOb type
if (BlobTbl.Fields[Index] is TblobField) then begin
pRecBuf := AllocMem(BlobTbl.RecordSize);
try
// Clone a cursor to the table so data aware controls keep their place
Check(DbiCloneCursor(BlobTbl.Handle, False, False, hCur));
Check(DbiSetToBegin(hCur));
// Iterate throuth the table removing BLOb information
while (DbiGetNextRecord(hCur, dbiWRITELOCK, pRecBuf, nil) = DBIERR_NONE)
do begin
// BDE funcstions use a 1 for the first field vs. Delphi's 0;
// add 1 to the index
Check(DbiOpenBlob(hCur, pRecBuf, Index + 1, dbiREADWRITE));
Check(DbiTruncateBlob(hCur, pRecBuf, Index + 1, 0));
Check(DbiModifyRecord(hCur, pRecBuf, True));
Check(DbiFreeBlob(hCur, pRecBuf, Index + 1));
end;
finally // Close cloned cursor and free record buffer memory
if (hCur <> nil) then
Check(DbiCloseCursor(hCur));
FreeMem(pRecBuf, BlobTbl.RecordSize);
end;
end
else
raise EDatabaseError.Create('Field: ' +
BlobTbl.Fields[Index].FieldName + ', is not a blob type');
end;
//***********************************************************************************
Undeletes a dBASE record if it is supported.
This example uses the following input:
fDbiUndeleteRecord(AnimalTbl);
The procedure is:
procedure fDbiUndeleteRecord(dBASETbl: TTable);
var
CProps: CurProps;
begin
Check(DbiGetCursorProps(dBASETbl.Handle, CProps));
// Raise an EDBEngineError exception if the table is not dBASE
if (StrIComp(CProps.szTableType, szDBASE) <> 0) then
raise EDBEngineError.Create(DBIERR_NOTSUPPORTED);
// Raise an EDatabaseError exception if the cursor does not have soft deletes on
if (CProps.bDeletedOn = False) then
raise EDatabaseError.Create('Soft deletes is not on');
Check(DbiUndeleteRecord(dBASETbl.Handle));
end;
//***********************************************************************************
Verifiy that the data specified is valid for the first field.
In this example, the field must be of type double. Blank is set to True if the field is blank.
This example uses the following input:
fDbiVerifyField(Table1.Handle, Blank);
The function is:
function fDbiVerifyField(hTmpCur: hDBICur; var Blank: Boolean): DbiResult;
var
Key: Double;
begin
Key:= 20000.00;
Result := DbiVerifyField(hTmpCur, 1, @key, Blank);
end;
//**************************************************************************************
Add multiple records to a table
This example assumes that the Customer TTable object is the Customer.DB table.
It uses the following input:
fDbiWriteBlock(Table1; NumRecs);
The procedure is:
procedure fDbiWriteBlock(Customer: TTable; var RecordsToInsert: Longint);
var
pRecordsBuf, pTmpBuf: pBYTE;
Rec: Longint;
CustNo: Double;
begin
Randomize;
GetMem(pRecordsBuf, Customer.RecordSize * RecordsToInsert);
pTmpBuf := pRecordsBuf;
try
for Rec := 1 to RecordsToInsert do begin
CustNo := Random(1000000);
// Iterate through the entire record buffer filling each
// individual record with information
with Customer do begin
Check(DbiInitRecord(Handle, pTmpBuf));
Check(DbiPutField(Handle, FieldByName('CustNo').Index + 1, pTmpBuf,
pBYTE(@CustNo)));
Check(DbiPutField(Handle, FieldByName('Company').Index + 1, pTmpBuf,
PChar('INPRISE Corporation')));
Inc(pTmpBuf, RecordSize);
end;
end;
Check(DbiWriteBLock(Customer.Handle, RecordsToInsert, pRecordsBuf));
finally
FreeMem(pRecordsBuf, Customer.RecordSize * RecordsToInsert);
end;
end;
//************************************************************************************
Display the specified field's memo.
The field specified in BlobIndex must be a valid memo blob and the BlobBuffer must be allocated. This example uses the following input:
fDbiGetBlob(BIOLIFE_TABLE, BIOLIFE_TABLE.FieldByName('Notes').Index,
BlobBuffer);
The procedure is defined as:
procedure fDbiGetBlob(InDataSet: TDataSet; BlobIndex: Word; var BlobInfo: string);
var
NumRead: longint;
begin
// Parameter iField of DbiOpenBlob requires an ordinal field number
Inc(BlobIndex);
InDataSet.UpdateCursorPos;
Check(DbiOpenBlob(InDataSet.Handle, InDataSet.ActiveBuffer, BlobIndex, dbiReadOnly));
Check(DbiGetBlobSize(InDataSet.Handle, InDataSet.ActiveBuffer, BlobIndex, NumRead));
SetLength(BlobInfo, NumRead);
Check(DbiGetBlob(InDataSet.Handle, InDataSet.ActiveBuffer, BlobIndex, 0,
NumRead, PChar(BlobInfo), longint(NumRead)));
Check(DbiFreeBlob(InDataSet.Handle, InDataSet.ActiveBuffer, BlobIndex));
end;
//*************************************************************************************
]]>