sdcommon.pas

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

    case UpdateStatus of
    usUnmodified:
      begin
        if sFields <> '' then sFields := sFields + ', ';
        sFields := sFields + QuoteIdentifier(sRealField, QuoteIdent);
        	// add a field alias, when it is necessary
        if sRealField <> Fields[i].FieldName then
          sFields := sFields + ' as ' + Fields[i].FieldName;
      end;
    usModified:
      if bIsModified then begin
        if sFields <> '' then sFields := sFields + ', ';
        if Fields[i].IsNull then
          sFields := sFields + Format( '%s%s = NULL', [SetIndent, QuoteIdentifier(sRealField, QuoteIdent)] )
        else
          sFields := sFields + Format( '%s%s = :%s', [SetIndent, QuoteIdentifier(sRealField, QuoteIdent), Fields[i].FieldName] );
      end;
    usInserted:
      if bIsModified then begin
        if sFields <> '' then sFields := sFields + ', ';
        sFields := sFields + QuoteIdentifier(sRealField, QuoteIdent);
        if sKeys <> '' then sKeys := sKeys + ', ';
        if Fields[i].IsNull then
          sKeys := sKeys + 'NULL'
        else
          sKeys := sKeys + ':' + Fields[i].FieldName;
      end;
    end;
    	// change WHERE clause for SELECT, UPDATE and DELETE statements
	// if all columns are used to locate the modified record or
      //upWhereChanged and upWhereKeyOnly use index fields. In any case, exclude Blob columns in WHERE clause
    if (UpdateStatus in [usUnmodified, usModified, usDeleted]) and not Fields[i].IsBlob and
       ( (UpdateMode = upWhereAll) or
         ((UpdateMode = upWhereChanged) and bIsModified) or
         ((UpdateMode = upWhereChanged) and (UpdateStatus in [usUnmodified])) or
         Fields[i].IsIndexField
       )
    then begin
      if sKeys <> ''
      then sKeys := sKeys + stAndOp;
      if Fields[i].OldValue = Null then
        sKeys := sKeys + Format( '%s%s is NULL', [SetIndent, QuoteIdentifier(sRealField, QuoteIdent)] )
      else
        sKeys := sKeys + Format( '%s%s = :OLD_%s', [SetIndent, QuoteIdentifier(sRealField, QuoteIdent), Fields[i].FieldName] )
    end;
  end;

  sTable := QuoteIdentifier(TableName, QuoteIdent);
  if (UpdateStatus in [usUnmodified, usModified, usDeleted]) and (sKeys <> '') then
    sKeys := stWhere + sKeys;
  case UpdateStatus of
    usUnmodified:
      if sKeys <> '' then
        Result := Format(stSelectFmt, [sFields, sTable + ' ' + sKeys]);
    usModified:
    	// if field's values are not modified (for example, new value is equal old one), Result will empty
      if sFields <> '' then
        Result := Format(stUpdateFmt, [sTable, sFields, sKeys]);
    usDeleted:
      Result := Format(stDeleteFmt, [sTable, sKeys]);
    usInserted:
      Result := Format(stInsertFmt, [sTable, sFields, sKeys]);
  end;
end;
{$ENDIF}

{ Insert repetable char Ch into string S: if find Ch then insert Ch after one }
function RepeatChar(Ch: Char; S: string): string;
var
  i: Integer;
begin
  i := 1;
  Result := S;
  while i <= Length(Result) do begin
    if Result[i] = Ch then begin
      Insert( Ch, Result, i+1 );
      Inc(i);
    end;
    Inc(i);
  end;
end;

// if UseQuote = True, bracket identifier(-es) in double quotes
function QuoteIdentifier(AName: string; UseQuote: Boolean): string;
var
  i: Integer;
begin
        // process a point delimiter OWNER.TABLE -> "OWNER"."TABLE"
  if UseQuote then begin
    Result := AName;
    i := 1;
    while i <= Length(Result) do begin
      if Result[i] = '.' then begin
        Insert( '"', Result, i );
        Inc(i);
        if (i + 1) <= Length(Result) then begin
          Insert( '"', Result, i + 1 );
          Inc(i);
        end;
      end;
      Inc(i);
    end;
    Result := '"' + Result + '"';
  end else
    Result := AName;
end;

// create ODBC command to call procedure (OLEDB uses ODBC syntax too)
function CreateProcedureCallCommand( AProcName: string; AParams: TSDHelperParams; IsMSSQL: Boolean ): string;
const
  ODBCParamMarker	= '?';
var
  i: Integer;
  sParams, sResult: string;
begin
  sParams := '';
  sResult := '';
  if Assigned(AParams) then for i:=0 to AParams.Count-1 do begin
    if AParams[i].ParamType in [ptResult] then
      sResult := ODBCParamMarker + '=';
    if not (AParams[i].ParamType in [ptInput, ptInputOutput, ptOutput]) then
      Continue;

    if Length(sParams) > 0 then
      sParams := sParams + ', ';
    sParams := sParams + ODBCParamMarker;
  end;
  	// ODBC driver for MSSQL (v.2000.81.x) returns error, when procedure w/o parameters is called with empty brackets as 'CALL PROC()'
  if IsMSSQL or (sParams <> '') then
    sParams := '(' + sParams + ')';
  Result := Format( '{%sCALL %s%s}', [sResult, AProcName, sParams] );
end;

// replace parameter names with prefix ':' on ODBC/OLEDB place holder '?'
function ReplaceParamMarkers( OldStmt: string; AParams: TSDHelperParams): string;
const
  ParamPrefix	= ':';
  ParamMarker	= '?';
var
  i, ParamPos: Integer;
  sFullParamName: string;
begin
  Result := OldStmt;
  if not Assigned(AParams) then
    Exit;
  for i:=0 to AParams.Count-1 do begin
    sFullParamName := ParamPrefix + AParams[i].Name;
    ParamPos := LocateText( sFullParamName, Result );
    if ParamPos = 0 then begin
        // check for quoted parameter names
      sFullParamName := ParamPrefix + '"'+AParams[i].Name+'"';
      ParamPos := LocateText( sFullParamName, Result );
      if ParamPos = 0 then
        Continue;
    end;
  	// remove parameter name with prefix(':')
    Delete( Result, ParamPos, Length(sFullParamName) );
  	// set parameter marker
    Insert( ParamMarker, Result, ParamPos );
  end;
end;

{$IFDEF SD_CLR}
// Returns nnumber of characters in a string excluding null terminator
function StrLen( S: TSDCharPtr ): Integer;
const
  ZS	= $00;
begin
  Result := 0;
  if not Assigned( S ) then
    Exit;
        // get string length
  while HelperMemReadByte( S, Result ) <> ZS do
    Inc(Result);
end;

function StrNew( S: TSDCharPtr ): TSDCharPtr;
var
  i: Integer;
begin
  Result := nil;
  i := StrLen( S );
  if i = 0 then
    Exit;
  Inc(i);	// size with null terminator
  Result := SafeReallocMem(nil, i);
  SafeCopyMem(S, Result, i);
end;
{$ENDIF}

{ Removes trailing spaces }
procedure StrRTrim( S: TSDCharPtr );
const
  SP	= $20;
  ZS	= $00;
var
  i: Integer;
begin
{$IFDEF SD_CLR}
  if not Assigned( S ) then
    Exit;
        // get string length
  i := StrLen( S );
  Dec(i);	// offset of the last char
  while i >= 0 do begin
    if HelperMemReadByte( S, i ) = SP then
      HelperMemWriteByte( S, i, ZS )
    else
      Break;
    Dec(i);
  end;
{$ELSE}
  i := -1;
  if AnsiStrComp(S, '') <> 0 then
    i := StrLen( S ) - 1;

  while i >= 0 do begin
    if S[i] = Char( SP ) then
      S[i] := Char( ZS )
    else
      Break;
    Dec( i );
  end;
{$ENDIF}
end;

{ Parse statement utility (later move to SDEngine or other common unit), it'll be useful for macro support }
// AnsiChar(..) is used to exclude Delphi 8 error "WideChar reduced to byte char in set expression"
function IsNameDelimiter(C: Char): Boolean;
begin
        // '(', ')' was added to correctly parse macro name like 'call %cProcName(10)'
        // '=' was added to correctly parse parameter name like ':param=1'
  Result := AnsiChar(C) in [' ', ',', ';', '(', ')', '=', #13, #10];
end;

function IsLiteral(C: Char): Boolean;
begin
  Result := AnsiChar(C) in ['''', '"'];
end;

function StripLiterals(const Str: string): string;
var
  Len: Integer;
begin
  Result := Str;
  Len := Length(Result);
  if (Len >= 1) and IsLiteral( Result[1] ) then
    Result := Copy( Result, 2, Length(Result)-1 );
  Len := Length(Result);
  if IsLiteral( Result[Len] ) then
    SetLength( Result, Len-1 );
end;

// AnsiString is used to exclude 'deprecate warning' in D8, 9
function LocateText(const Substr, S: AnsiString): Integer;
begin
        // Pos works with single-byte character sets in contrast to AnsiPos
  Result := AnsiPos( AnsiUpperCase(Substr), AnsiUpperCase(S) );
end;

function StrFindFromPos(const Substr, S: string; StartPos: Integer): Integer;
var
  Str: string;
begin
  if StartPos > 1 then
  	// Copy returns empty string when StartPos > Length(S)
    Str := Copy(S, StartPos, Length(S) - StartPos + 1)
  else begin
    Str := S;
    StartPos := 1;
  end;
  Result := LocateText( Substr, Str );
  if Result > 0 then
    Result := StartPos + (Result - 1);	// return an index of Pascal string
end;

{ Returns False, when nothing is changed. Once parameter specifies only one changing }
function ReplaceString( Once: Boolean; OldStr, NewStr: string; var ResultStr: string ): Boolean;
var
  i, FoundPos, Literals: Integer;
  bFound: Boolean;
begin
  Result := False;

  repeat
    FoundPos := 0;
    repeat
    	// pass the first char of the similar string, which was found earlier
      if FoundPos > 0 then Inc(FoundPos);
      FoundPos := StrFindFromPos( OldStr, ResultStr, FoundPos );
    	// check whether OldStr at the end of ResultStr or has a delimiter after itself
      bFound :=
    	(FoundPos > 0) and
    	((Length(ResultStr) = FoundPos + Length(OldStr) - 1) or
          IsNameDelimiter( ResultStr[FoundPos + Length(OldStr)] )
        );

      if bFound then begin
        Literals := 0;
        for i := 1 to FoundPos - 1 do
          if IsLiteral(ResultStr[i]) then Inc(Literals);
        bFound := Literals mod 2 = 0;	// OldStr has not to be quoted
        if bFound then begin
          Delete( ResultStr, FoundPos, Length(OldStr) );
          Insert( NewStr, ResultStr, FoundPos );
          FoundPos := FoundPos + Length(NewStr) - 1;
          Result := True;
          if Once then
            Exit;
        end;
      end;
    until FoundPos = 0;
  until not bFound;

end;


{----------------------- END OF UTILITY FUNCTIONS/PROCEDURES ------------------}

function IsBlobType(FieldType: TFieldType): Boolean;
begin
  Result := FieldType in BlobTypes;
end;

function IsSupportedBlobTypes(FieldType: TFieldType): Boolean;
begin
  Result := FieldType in SupportedBlobTypes;
end;

function IsRequiredSizeTypes(FieldType: TFieldType): Boolean;
begin
  Result := FieldType in RequiredSizeTypes;
end;

function IsDateTimeType(FieldType: TFieldType): Boolean;
begin
  Result := FieldType in DateTimeTypes;
end;

function IsNumericType(FieldType: TFieldType): Boolean;
begin
  Result := FieldType in NumericTypes;
end;

function GetAppName: string;
begin