sdengine.pas

SQLDirect Component Library is a light-weight Borland Database Engine replacement for Borland Delphi

{ MIDAS uses '?' parameter marker, which is supported in Interbase, DB2, Informix and ODBC only.
 I.e. for some servers it is necessary to change a parameter marker from '?' to ':NAME' }
function ReplaceQuestionParamMarker(AServerType: TSDServerType; ASQL :string; AParams: TSDHelperParams): string;
var
  i: Integer;
begin
  Result := ASQL;

  if (AServerType in [stDB2, stInformix, stODBC, stInterbase]) or
     not Assigned(AParams) or (AParams.Count = 0)
  then
    Exit;
  if Pos('?', ASQL) = 0 then
    Exit;

  for i:=0 to AParams.Count-1 do begin
    if AParams[i].Name = '' then
      AParams[i].Name := IntToStr( i+1 );
      // it is necessary to change only one '?' marker per parameter
    ReplaceString( True, '?', DefaultParamPrefix + AParams[i].Name, Result);
  end;
end;

procedure SetUnknownParamTypeToInput(P: TSDHelperParams);
var
  i: Integer;
begin
  for i:=0 to P.Count-1 do
    if P[i].ParamType = ptUnknown then
      P[i].ParamType := ptInput;
end;


type

{ TSDQueryDataLink }
  TSDCustomQueryDataLink = {$IFDEF SD_VCL4} TDetailDataLink {$ELSE} TDataLink {$ENDIF};

  TSDQueryDataLink = class( TSDCustomQueryDataLink )
  private
    FQuery: TSDQuery;
  protected
    procedure ActiveChanged; override;
    procedure RecordChanged(Field: TField); override;
{$IFDEF SD_VCL4}
    function GetDetailDataSet: TDataSet; override;
{$ENDIF}
    procedure CheckBrowseMode; override;
  public
    constructor Create(AQuery: TSDQuery);
  end;


{ Utility routines }
  
function DefaultSession: TSDSession;
begin
  Result := SDEngine.Session;
end;

{ Error and exception handling routines }

procedure SDEError(ErrorCode: TSDEResult);
begin
  ResetBusyState;
  raise ESDEngineError.CreateDefPos(ErrorCode, ErrorCode, '');
end;

procedure SDECheck(Status: TSDEResult);
begin
  if Status <> 0 then SDEError(Status);
end;

function GetRecInfoStruct(RecBuf: TSDRecordBuffer; Offset: Integer): TSDRecInfo;
begin
{$IFDEF SD_CLR}
  Result := TSDRecInfo( Marshal.PtrToStructure( TSDPtr(Longint(RecBuf) + Offset), TypeOf(TSDRecInfo) ) );
{$ELSE}
  Result := PSDRecInfo( RecBuf + Offset )^;
{$ENDIF}
end;

procedure SetRecInfoStruct(RecBuf: TSDRecordBuffer; Offset: Integer; ARecInfo: TSDRecInfo); overload;
begin
{$IFDEF SD_CLR}
  Marshal.StructureToPtr( ARecInfo, TSDPtr(Longint(RecBuf) + Offset), False );
{$ELSE}
  PSDRecInfo( RecBuf + Offset )^ := ARecInfo;
{$ENDIF}
end;

procedure SetRecInfoStruct(RecBuf: TSDRecordBuffer; Offset: Integer; ARecNumber: Longint); overload;
begin
{$IFDEF SD_CLR}
  Marshal.WriteInt32( RecBuf, Offset, ARecNumber );
{$ELSE}
  PSDRecInfo( RecBuf + Offset )^.RecordNumber := ARecNumber;
{$ENDIF}
end;

procedure SetRecInfoStruct(RecBuf: TSDRecordBuffer; Offset: Integer; AValue: TUpdateStatus); overload;
begin
{$IFDEF SD_CLR}
  Marshal.WriteByte( RecBuf, Offset + SizeOf(Longint), Byte( AValue ) );
{$ELSE}
  PSDRecInfo( RecBuf + Offset )^.UpdateStatus := AValue;
{$ENDIF}
end;

procedure SetRecInfoStruct(RecBuf: TSDRecordBuffer; Offset: Integer; AValue: TBookmarkFlag); overload;
begin
{$IFDEF SD_CLR}
  Marshal.WriteByte( RecBuf, Offset + SizeOf(Longint) + SizeOf(Byte), Byte( AValue ) );
{$ELSE}
  PSDRecInfo( RecBuf + Offset )^.BookmarkFlag := AValue;
{$ENDIF}
end;

function GetBookmarkRecStruct(RecBuf: TSDRecordBuffer; Offset: Integer): TBookmarkRec;
begin
{$IFDEF SD_CLR}
  Result := TBookmarkRec( Marshal.PtrToStructure( TSDPtr(Longint(RecBuf) + Offset), TypeOf(TBookmarkRec) ) );
{$ELSE}
  Result := PBookmarkRec( RecBuf + Offset )^;
{$ENDIF}
end;

procedure SetBookmarkRecStruct(RecBuf: TSDRecordBuffer; Offset: Integer; ABookRec: TBookmarkRec); overload;
begin
{$IFDEF SD_CLR}
  Marshal.StructureToPtr( ABookRec, TSDPtr(Longint(RecBuf) + Offset), False );
{$ELSE}
  PBookmarkRec( RecBuf + Offset )^ := ABookRec;
{$ENDIF}
end;

procedure SetBookmarkRecStruct(RecBuf: TSDRecordBuffer; Offset: Integer; APos: Longint); overload;
begin
{$IFDEF SD_CLR}
  Marshal.WriteInt32( RecBuf, Offset, APos );
{$ELSE}
  PBookmarkRec( RecBuf + Offset )^.iPos := APos;
{$ENDIF}
end;


{$IFDEF SD_CLR}
function StrLen(APtr: TSDValueBuffer): Integer;
var
  b: Byte;
begin
  Result := 0;
  if not Assigned(APtr) then
    Exit;
  b := Marshal.ReadByte( APtr, Result );
  while b <> 0 do begin
    Inc(Result);
    b := Marshal.ReadByte( APtr, Result );
  end;
end;
{$ENDIF}

// the following procedure are necessary to exclude ambiguity with TDataSet.Insert/Delete methods
procedure DeleteSubstr(var S: string; Index, Count:Integer);
begin
  Delete(S, Index, Count);
end;

procedure InsertSubstr(Source: string; var S: string; Index: Integer);
begin
  Insert(Source, S, Index);
end;


{*******************************************************************************
				TSDSessionList
*******************************************************************************}
constructor TSDSessionList.Create;
begin
  inherited Create;
  FSessions := TThreadList.Create;
  FSessionNumbers := TBits.Create;
  InitializeCriticalSection(FCSect);
end;

destructor TSDSessionList.Destroy;
begin
  CloseAll;
  DeleteCriticalSection(FCSect);
  FSessionNumbers.Free;
  FSessions.Free;
  inherited Destroy;
end;

procedure TSDSessionList.AddSession(ASession: TSDSession);
var
  List: TList;
begin
  List := FSessions.LockList;
  try
    if List.Count = 0 then
      ASession.FDefault := True;
    List.Add(ASession);
  finally
    FSessions.UnlockList;
  end;
end;

procedure TSDSessionList.CloseAll;
var
  I: Integer;
  List: TList;
begin
  List := FSessions.LockList;
  try
    for I := List.Count-1 downto 0 do
      TSDSession(List[I]).Free;
    SDEngine.Session := nil;	// default session is destroyed now
  finally
    FSessions.UnlockList;
  end;
end;

function TSDSessionList.GetCount: Integer;
var
  List: TList;
begin
  List := FSessions.LockList;
  try
    Result := List.Count;
  finally
    FSessions.UnlockList;
  end;
end;

function TSDSessionList.GetSession(Index: Integer): TSDSession;
var
  List: TList;
begin
  List := FSessions.LockList;
  try
    Result := TSDSession( List[Index] );
  finally
    FSessions.UnlockList;
  end;
end;

function TSDSessionList.GetSessionByName(const SessionName: string): TSDSession;
begin
  if SessionName = '' then
    Result := Session
  else
    Result := FindSession(SessionName);
  if Result = nil then
    DatabaseErrorFmt(SInvalidSessionName, [SessionName]);
end;

function TSDSessionList.FindDatabase(const DatabaseName: string): TSDDatabase;
var
  i: Integer;
  List: TList;
begin
  Result := nil;

  List := FSessions.LockList;
  try
    for i:=0 to List.Count-1 do begin
      Result := TSDSession( List[i] ).FindDatabase( DatabaseName );
      if Result <> nil then
        Break;
    end;
  finally
    FSessions.UnlockList;
  end;
end;

function TSDSessionList.FindSession(const SessionName: string): TSDSession;
var
  I: Integer;
  List: TList;
begin
  if SessionName = '' then
    Result := Session
  else begin
    List := FSessions.LockList;
    try
      for I := 0 to List.Count - 1 do begin
        Result := TSDSession( List[I] );
        if CompareText( Result.SessionName, SessionName ) = 0 then
          Exit;
      end;
      Result := nil;
    finally
      FSessions.UnlockList;
    end;
  end;
end;

procedure TSDSessionList.GetSessionNames(List: TStrings);
var
  I: Integer;
  SList: TList;
begin
  List.BeginUpdate;
  try
    List.Clear;
    SList := FSessions.LockList;
    try
      for I := 0 to SList.Count - 1 do
        with TSDSession( SList[I] ) do
          List.Add(SessionName);
    finally
      FSessions.UnlockList;
    end;
  finally
    List.EndUpdate;
  end;
end;

function TSDSessionList.OpenSession(const SessionName: string): TSDSession;
begin
  Result := FindSession(SessionName);
  if Result = nil then begin
    Result := TSDSession.Create(nil);
    Result.SessionName := SessionName;
  end;
  Result.SetActive(True);
end;