asgsqlite3.pas

定时器for timer for ic chip

  Begin
    p2 := pos(')', FieldInfo);
    If p2 <> 0 Then
    Begin
      vt := LowerCase(Copy(FieldInfo, 1, p1 - 1));
      If (vt = 'varchar') Or (vt = 'char') Or (vt = 'varchar2') Then
      Begin
        FieldType := ftString;
        FieldLen := StrToInt(Copy(FieldInfo, p1 + 1, p2 - p1 - 1));
      End Else If (vt = 'nvarchar') Or (vt = 'nchar') Or (vt = 'nvarchar2') Then
      Begin
        FieldType := ftWideString;
        FieldLen := StrToInt(Copy(FieldInfo, p1 + 1, p2 - p1 - 1)) * 2;
      End Else If (vt = 'numeric') Then
      Begin
        vt := Copy(FieldInfo, p1 + 1, p2 - p1 - 1);
        pn := pos('.', vt);
        If pn = 0 Then pn := pos(',', vt);
        FieldType := ftFloat;
        If pn = 0 Then
        Begin
          FieldLen := StrToInt(vt);
          FieldDec := 0;
        End Else
        Begin
          FieldLen := StrToInt(Copy(vt, 1, pn - 1));
          FieldDec := StrToInt(Copy(vt, pn + 1, 2));
        End;
      End;
    End
    Else
      FieldLen := 256;
  End
  Else
  Begin
    vt := LowerCase(FieldInfo);
    If vt = 'date' Then
    Begin
      FieldType := ftDate;
      FieldLen := 10;
    End
    Else If vt = 'datetime' Then
    Begin
      FieldType := ftDateTime;          // fpierce original ftDate
      FieldLen := 24;                   // aducom
    End
    Else If vt = 'time' Then
    Begin
      FieldType := ftTime;
      FieldLen := 12;
    End
      {$IFDEF ASQLITE_D6PLUS}
    Else If vt = 'timestamp' Then
    Begin
      FieldType := ftTimeStamp;
      FieldLen := 12;
    End
      {$ENDIF}
    Else If (vt = 'integer') Or (vt = 'int') Then
    Begin
      FieldType := ftInteger;
      FieldLen := 12;
    End
    Else If (vt = 'float') Or (vt = 'real') Then
    Begin
      FieldType := ftFloat;
      FieldLen := 12;
    End
    Else If (vt = 'boolean') Or (vt = 'logical') Then
    Begin
      FieldType := ftBoolean;
      FieldLen := 2;
    End
    Else If (vt = 'char') Or (vt = 'byte') Then
    Begin
      FieldType := ftString;
      FieldLen := 1;
    End
    Else If (vt = 'shorttext') Or (vt = 'string') Then
    Begin
      FieldType := ftString;
      FieldLen := 255;
    End
    Else If (vt = 'widetext') Or (vt = 'widestring') Then
    Begin
      FieldType := ftWideString;
      FieldLen := 512;
    End
    Else If (vt = 'currency') Or (vt = 'financial') Or (vt = 'money') Then
    Begin
      FieldType := ftCurrency;
      FieldLen := 10;
    End
    Else If (vt = 'blob') Then
    Begin
      FieldType := ftBlob;
      FieldLen := SizeOf(Pointer);
    End
    Else If (vt = 'graphic') Then
    Begin
      FieldType := ftGraphic;
      FieldLen := SizeOf(Pointer);
    End
    Else If (vt = 'clob') Or (vt = 'memo') Or (vt = 'text') Or (vt = 'longtext') Then
    Begin
      FieldType := ftMemo;
      FieldLen := SizeOf(Pointer);
    End;
  End;
  DebugLeave('GetFieldInfo: ' + vt);
End;

//==============================================================================
// Convert TDateTime to TDateTimeRec
//==============================================================================

Function DateTimeToNative(DataType: TFieldType; Data: TDateTime): TDateTimeRec;
Var
  TimeStamp: TTimeStamp;
Begin
  DebugEnter('DateTimeToNative');
  TimeStamp := DateTimeToTimeStamp(Data);
  Case DataType Of
    ftDate: Result.Date := TimeStamp.Date;
    ftTime: Result.Time := TimeStamp.Time;
  Else
    Result.DateTime := TimeStampToMSecs(TimeStamp);
  End;
  DebugLeave('DateTimeToNative');
End;

Procedure ApplicationHandleException(Sender: TObject);
Begin
  {$IFDEF ASQLITE_D6PLUS}
  If Assigned(Classes.ApplicationHandleException) Then
    Classes.ApplicationHandleException(Sender);
  {$ENDIF}
End;

//============================================================================== TASQLite3LOG

Procedure TASQLite3Log.Display(Msg: String);
Var
  fn: Textfile;
Begin
  DebugEnter('TASQLite3Log.Display');
  If FileExists(FLogFile) Then
  Begin
    If FAppend Then
    Begin
      AssignFile(fn, FLogFile);
      System.Append(fn);
    End
    Else
    Begin
      SysUtils.DeleteFile(FLogFile);
      AssignFile(fn, FLogFile);
      Rewrite(fn);
    End;
  End
  Else
  Begin
    AssignFile(fn, FLogFile);
    Rewrite(fn);
  End;
  Writeln(fn, FormatDateTime('yyyy mmm dd (hh:nn:ss) ', now) + Msg);
  CloseFile(fn);
  DebugLeave('TASQLite3Log.Display');
End;

//============================================================================== TASQLite3PRAGMA

Function TASQLite3Pragma.GetTempCacheSize: String;
Begin
  DebugEnter('TASQLite3Pragma.GetTempCacheSize');
  GetTempCacheSize := 'pragma cache_size=' + IntToStr(FTempCacheSize);
  DebugLeave('TASQLite3Pragma.GetTempCacheSize');
End;

Function TASQLite3Pragma.GetDefaultCacheSize: String;
Begin
  DebugEnter('TASQLite3Pragma.GetDefaultCacheSize');
  GetDefaultCacheSize := 'pragma default_cache_size=' + IntToStr(FDefaultCacheSize);
  DebugLeave('TASQLite3Pragma.GetDefaultCacheSize');
End;

Function TASQLite3Pragma.GetDefaultSynchronous: String;
Begin
  DebugEnter('TASQLite3Pragma.GetDefaultSynchronous');
  GetDefaultSynchronous := 'pragma default_synchronous=' + FDefaultSynchronous;
  DebugLeave('TASQLite3Pragma.GetDefaultSynchronous');
End;

Function TASQLite3Pragma.GetDefaultTempStore: String;
Begin
  DebugEnter('TASQLite3Pragma.GetDefaultTempStore');
  GetDefaultTempStore := 'pragma default_temp_store=' + FDefaultTempStore;
  DebugLeave('TASQLite3Pragma.GetDefaultTempStore');
End;

Function TASQLite3Pragma.GetTempStore: String;
Begin
  DebugEnter('TASQLite3Pragma.GetTempStore');
  GetTempStore := 'pragma temp_store=' + FTempStore;
  DebugLeave('TASQLite3Pragma.GetTempStore');
End;

Function TASQLite3Pragma.GetSynchronous: String;
Begin
  DebugEnter('TASQLite3Pragma.GetSynchronous');
  GetSynchronous := 'pragma synchronous=' + FSynchronous;
  DebugLeave('TASQLite3Pragma.GetSynchronous');
End;

//============================================================================== TFRESULT
// TResult is a representation of an internal pointerlist of results.
// Only 'normal' results will be stored internally within a fixed memory block
// depending on calculated length internally. This is not the case
// for blobs and clobs. In this case only the handle is stored in the fixed
// structure and a separate memory handle is retrieved to store the blob and
// clob data. This is because the blobs are stored as null terminated 'strings'
// and thus have different lengths. No more memory is allocated this way than
// strictly necessary.
// KEEP IN MIND: ...
//     This resultset is NOT used for unidirectional search results. You can
//     however, open a dbgrid containing griddata. You cannot update your data
//     if you use the unidirectional the result is read-only by default and cannot
//     be changed.
//     The unidirectional dataset improves performance on large resultsets and
//     is to be considered for query-only components...
//==============================================================================

Constructor TFResult.Create(TheDataSet: TASQLite3BaseQuery);
Begin
  DebugEnter('TFResult.Create');
  Data := TList.Create;
  Bookmark := TList.Create;
  RowId := TList.Create;
  FDataSet := TheDataSet;
  FLastBookmark := -1;                  // 2004-14-09 (rps) 0 -> -1 (otherwise insert in an empty table gives index out of range)
  DebugLeave('TFResult.Create');
End;

Destructor TFResult.Destroy;
Var
  ptr: Pointer;
  I: integer;
Begin
  DebugEnter('TFResult.Destroy');
  FreeBlobs;
  If Assigned(Data) Then
  Begin
    For I := 0 To Data.Count - 1 Do
    Begin
      ptr := Data.Items[I];
      If Assigned(ptr) Then FreeMem(ptr, FBufSize);
    End;
    Data.Free;                          // D4 compatibility, otherwise FreeAndNil could be used
    Data := Nil;
  End;

  If Assigned(Bookmark) Then
  Begin
    Bookmark.Free;
    Bookmark := Nil;
  End;

  If Assigned(RowId) Then
  Begin
    RowId.Free;
    RowId := Nil;
  End;

  DebugLeave('TFResult.Destroy');
End;

Procedure TFResult.FreeBlobs;
Var
  I, j: integer;
  offset: integer;
  ptr: PAnsiChar;
  stream: TMemoryStream;
Begin
  If Not Assigned(FDataSet) Then exit;
  If Not Assigned(FDataSet.FieldList) Then exit;
  For j := 0 To Data.Count - 1 Do
  Begin
    ptr := GetData(j);
    For I := 0 To FDataSet.FieldList.Count - 1 Do
    Begin
      If FDataSet.FieldList[I].DataType In [ftMemo, ftFmtMemo, ftGraphic, ftBlob] Then
      Begin
        offset := FDataSet.GetFieldOffset(FDataSet.FieldList[I].FieldNo);
        Move((ptr + offset)^, Pointer(stream), SizeOf(Pointer));
        stream.Free;
      End;
    End;
  End;
End;

Procedure TFResult.SetBufSize(TheSize: integer);
Begin
  DebugEnter('TFResult.SetBufSize');
  FBufSize := TheSize;
  DebugLeave('TFResult.SetBufSize');
End;

//==============================================================================
// Adds a row of data to the resultset.
//==============================================================================

Procedure TFResult.Add(TheBuffer: PAnsiChar; TheRowId: integer);
Var
  ptr: PAnsiChar;
  //  i:   integer;
Begin
  {$IFDEF DEBUG_VERY_LOUD}
  DebugEnter('TFResult.Add');
  {$ENDIF}
  inc(FLastBookmark);
  GetMem(ptr, FBufSize);
  Move(TheBuffer^, ptr^, FBufSize);
  Data.Add(ptr);
  Bookmark.Add(Pointer(FLastBookmark));
  If TheRowId >= 0 Then
    RowId.Add(Pointer(TheRowId))
  Else
    RowId.Add(Pointer(RowId.Count));
  {$IFDEF DEBUG_VERY_LOUD}
  DebugLeave('TFResult.Add');
  {$ENDIF}
End;

//==============================================================================
// Inserts a row of date into the resultset
//==============================================================================

Procedure TFResult.Insert(Index: integer; TheBuffer: Pointer; TheRowId: integer);
Var
  ptr: Pointer;
Begin
  DebugEnter('TFResult.Insert');
  inc(FLastBookmark);
  GetMem(ptr, FBufSize);
  Move(TheBuffer^, ptr^, FBufSize);
  If Data.Count < Index Then
  Begin
    Data.Add(ptr);
    Bookmark.Add(Pointer(FLastBookmark));
    RowId.Add(Pointer(TheRowId));
  End Else
  Begin
    Data.Insert(Index, ptr);
    Bookmark.Insert(Index, Pointer(FLastBookmark));
    RowId.Insert(Index, Pointer(TheRowId));
  End;
  DebugLeave('TFResult.Insert');
End;

//==============================================================================
// Deletes a row of data from the resultset
//==============================================================================