sdcommon.pas

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

  Result := ExtractFileName( Application.ExeName );
end;

function GetComputerNameStr: AnsiString;
var
  nSize: {$IFDEF SD_VCL4}Cardinal{$ELSE}Integer{$ENDIF};
{$IFNDEF SD_CLR}
  szCompName: PChar;
begin
  Result := '';
  nSize := MAX_COMPUTERNAME_LENGTH + 1;
  szCompName := StrAlloc( nSize );
  try
    if GetComputerName(szCompName, nSize) then
      if nSize > 0 then
        Result := StrPas(szCompName);
  finally
    StrDispose( szCompName );
  end;
{$ELSE}
  sb: StringBuilder;
begin
  Result := '';
  nSize := MAX_COMPUTERNAME_LENGTH + 1;
  sb := StringBuilder.Create(nSize);
  if GetComputerName(sb, nSize) and (nSize > 0) then
    Result := sb.ToString;
{$ENDIF}
end;

function GetModuleFileNameStr(hModule: HINST): string;
var
  nSize: Integer;
{$IFNDEF SD_CLR}
  szLib: array[0..MAX_PATH] of Char;
begin
  nSize := GetModuleFileName(hModule, szLib, MAX_PATH);
  if nSize > 0 then begin
    szLib[nSize] := #$00;
    SetString(Result, szLib, nSize);
  end else begin
    nSize := GetLastError;
    raise Exception.CreateFmt('System error %d', [nSize]);
  end;
{$ELSE}
  sb: StringBuilder;
begin
  Result := '';
  nSize := MAX_PATH + 1;
  sb := StringBuilder.Create(nSize);
  try
    nSize := Windows.GetModuleFileName(hModule, sb, MAX_PATH);
    if nSize > 0 then
      Result := sb.ToString
    else begin
        // in Delphi 8 IDE GetModuleFileName returns an empty string and GetLastError returns 0
      nSize := GetLastError;
      raise Exception.CreateFmt('System error %d', [nSize]);
    end;
  finally
    sb.Free;
  end;
{$ENDIF}
end;

function GetHostName: string;
begin
  Result := GetComputerNameStr;
end;

function GetSQLDirectVersion: string;
begin
  Result := SSQLDirectVersion;
end;

{ Returns a parameter name for the specified server }
function GetSqlLibParamName(ServerTypeCode: Integer): string;
var
  s: string;
  st: TISqlServerType;
begin
  Result := '';
  s := '';
  for st:=Low(ServerTypeNames) to High(ServerTypeNames) do
    if Ord(st) = ServerTypeCode then begin
      s := ServerTypeNames[st];
      Break;
    end;
  if s <> '' then
    Result := Format(szAPILIBRARY_FMT, [s]);
end;

function ExtractLibName(const LibNames: string; Sep: Char; var Pos: Integer): string;
var
  I: Integer;
begin
  I := Pos;
  while (I <= Length(LibNames)) and (LibNames[I] <> Sep) do
    Inc(I);
  Result := Trim( Copy(LibNames, Pos, I - Pos) );
  if (I <= Length(LibNames)) and (LibNames[I] = Sep) then
    Inc(I);
  Pos := I;
end;

{
  Extracts only stored procedure name(with owner) from full name ( <owner.procname;group_no> )
  Used by SDMss and SDSyb units
}
function ExtractStoredProcName(const sFullProcName: string): string;
var
  i: Integer;
begin
  Result := sFullProcName;

  i := Pos(';', Result);
	// if group number separator (;) found
  if i > 0 then
    Result := Copy( Result, 1, i-1 );
end;

{ functions to parsing TSDDatabase.RemoteDatabase property. They're used in SDMss.pas, SDMySQL.pas }
function ExtractServerName(const sRemoteDatabase: string): string;
var
  i: Integer;
begin
  Result := sRemoteDatabase;
	// looking delimiter
  i := 1;
  while i <= Length(Result) do begin
    if IsDelimiter(ServerDelimiters, Result, i) then
      Break;
    Inc(i);
  end;
	// extract substring before delimiter
  if i <= Length(Result) then
    Result := Copy(Result, 1, i-1);
end;

function ExtractDatabaseName(const sRemoteDatabase: string): string;
var
  i: Integer;
begin
  Result := '';
	// looking delimiter
  i := 1;
  while i <= Length(sRemoteDatabase) do begin
    if IsDelimiter(ServerDelimiters, sRemoteDatabase, i) then
      Break;
    Inc(i);
  end;
	// extract substring after delimiter
  if i < Length(sRemoteDatabase) then begin
    Result := Copy(sRemoteDatabase, i+1, Length(sRemoteDatabase)-i);
    	// exclude repeated delimiters, in case of presence    
    while Length(Result) > 0 do
      if IsDelimiter(ServerDelimiters, Result, 1) then begin
        if Length(Result) = 1 then
          Result := ''
        else
          Result := Copy(Result, 2, Length(Result)-1)
      end else
        Break;
  end;
end;

// if s contains wildcards for LIKE operator, only '%' wildcard is checked. If one '_' wildcard is used, then IB6.5 does not return correct rows
function ContainsLikeWildcards(const s: string): Boolean;
begin
  Result := Pos('%', s) > 0;
end;

{ Splits AFullObjName on owner and object names, which are separated by point.
Returns False if an owner value is empty. In case of empty Owner or Obj value,
it is replaced by '%' to use with LIKE predicat }
function ExtractOwnerObjNames(const AFullObjName: string; var AOwnerName, AObjName: string): Boolean;
var
  i: Integer;
begin
  Result := False;
  i := Pos('.', AFullObjName);
  if i >= 0 then begin
    AOwnerName := Copy(AFullObjName, 0, i-1);
    AObjName := Copy(AFullObjName, i+1, Length(AFullObjName)-i);
    Result := True;
  end else
    AObjName := AFullObjName;

  if Trim(AOwnerName) = '' then
    AOwnerName := '%';
  if Trim(AObjName) = '' then
    AObjName := '%';
end;

{ Returns file version, which is encrypted in integer number }
function GetFileVersion(const FileName: string): LongInt;
type
  TTransTable = array[0..0,0..1] of Word;
var
  bOk: Boolean;
  InfoSize, Len: DWORD;
  lpInfoData: TBytes;
  pFileInfo: TSDPtr;
{$IFDEF SD_CLR}
  FileInfo: TVSFixedFileInfo;
  dwVer: DWORD;
{$ELSE}
  pTransTable: ^TTransTable;
  szStringValue: PChar;
  sLangCharSet: string;
{$ENDIF}
begin
  Result := 0;
  InfoSize := GetFileVersionInfoSize( {$IFDEF SD_CLR}FileName{$ELSE}PChar(FileName){$ENDIF}, Len );
  if InfoSize <= 0 then
    Exit;

  SetLength(lpInfoData, InfoSize);
  try
    bOk := GetFileVersionInfo( {$IFDEF SD_CLR}FileName{$ELSE}PChar(FileName){$ENDIF}, 0, InfoSize, lpInfoData );
    bOk := bOk and VerQueryValue( lpInfoData, '\', pFileInfo, Len );
    if not bOk then
      Exit;
{$IFDEF SD_CLR}
    FileInfo := TVSFixedFileInfo(Marshal.PtrToStructure(pFileInfo, TypeOf(TVSFixedFileInfo)));
    dwVer := FileInfo.dwFileVersionMS;
    Result:= MakeVerValue(dwVer shr 16, dwVer and $FFFF);
{$ELSE}
    if VerQueryValue(lpInfoData, '\VarFileInfo\Translation', Pointer(pTransTable), Len) then
      sLangCharSet := IntToHex(pTransTable^[0,0], 4) + IntToHex(pTransTable^[0,1], 4);
    if VerQueryValue(lpInfoData, PChar('\StringFileInfo\'+sLangCharSet+'\FileVersion'), Pointer(szStringValue), Len) then
      Result := VersionStringToDWORD(StrPas(szStringValue));
{$ENDIF}
  finally
    SetLength(lpInfoData, 0);
  end;
end;

procedure ReadFileVersInfo(const FileName: string; var ProductName, VersStr: string);
type
  TTransTable = array[0..0,0..1] of Word;
var
  bOk: Boolean;
  InfoSize, Len: DWORD;
  lpInfoData: TBytes;
  pFileInfo: TSDPtr;
  FileInfo: TVSFixedFileInfo;
{$IFDEF SD_CLR}
  pTransTable: TSDPtr;
{$ELSE}
  pTransTable: ^TTransTable;
{$ENDIF}
  sBeta, sLangCharSet, sSubBlock: string;
  szStringValue: TSDCharPtr;
begin
  sBeta := '';
  InfoSize := GetFileVersionInfoSize( {$IFDEF SD_CLR}FileName{$ELSE}PChar(FileName){$ENDIF}, Len );

  if InfoSize <= 0 then Exit;

  SetLength(lpInfoData, InfoSize);
  try
    bOk := GetFileVersionInfo( {$IFDEF SD_CLR}FileName{$ELSE}PChar(FileName){$ENDIF}, 0, InfoSize, lpInfoData );
    bOk := bOk and VerQueryValue( lpInfoData, '\', pFileInfo, Len );

    if not bOk then Exit;

{$IFDEF SD_CLR}
    FileInfo := TVSFixedFileInfo( Marshal.PtrToStructure(pFileInfo, TypeOf(TVSFixedFileInfo)) );
{$ELSE}
    FileInfo := TVSFixedFileInfo( pFileInfo^ );
{$ENDIF}
    if (FileInfo.dwFileFlags and VS_FF_PRERELEASE) <> 0 then
      sBeta := 'beta';

    VersStr := Format('%d.%d.%d%s',
    	[FileInfo.dwFileVersionMS shr 16,
         FileInfo.dwFileVersionMS and $0000FFFF,
	 FileInfo.dwFileVersionLS shr 16,
         sBeta
        ]);
{$IFDEF SD_CLR}
    if VerQueryValue(lpInfoData, '\VarFileInfo\Translation', TSDPtr(pTransTable), Len) then
      sLangCharSet := IntToHex( HelperMemReadInt16(pTransTable, 0), 4) + IntToHex( HelperMemReadInt16(pTransTable, SizeOf(Word)), 4);
{$ELSE}
    if VerQueryValue(lpInfoData, '\VarFileInfo\Translation', TSDPtr(pTransTable), Len) then
      sLangCharSet := IntToHex(pTransTable^[0,0], 4) + IntToHex(pTransTable^[0,1], 4);
{$ENDIF}
    sSubBlock := '\StringFileInfo\'+sLangCharSet+'\ProductName';
    if VerQueryValue(lpInfoData, {$IFDEF SD_CLR}sSubBlock{$ELSE}PChar(sSubBlock){$ENDIF}, TSDPtr(szStringValue), Len) then
      ProductName := {$IFDEF SD_CLR}Marshal.PtrToStringAuto( szStringValue ){$ELSE}szStringValue{$ENDIF};	// it is necessary to PtrToStringAuto for Dephi 8 (PtrToStringAnsi converts only the first symbol)
  finally
    SetLength(lpInfoData, 0);
  end;
end;


{$IFNDEF SD_CLR}

{ Case-sensitive }
function ContainsStr(const AStr, ASubStr: string): Boolean;
begin
{$IFDEF SD_VCL6}
  Result := AnsiContainsStr(AStr, ASubStr);
{$ELSE}
  Result := AnsiPos(ASubStr, AStr) > 0;
{$ENDIF}
end;

{ Case-insensitive }
function ContainsText(const AStr, ASubStr: string): Boolean;
begin
{$IFDEF SD_VCL6}
  Result := AnsiContainsText(AStr, ASubStr);
{$ELSE}
  Result := AnsiPos(AnsiUpperCase(ASubStr), AnsiUpperCase(AStr)) > 0;
{$ENDIF}
end;

{$ENDIF}

// It is necessary to use one call in D8(where Ansi.. functions are deprecated) and D4-7 implementation
function HelperCompareStr(const S1, S2: string): Integer;
begin
{$IFDEF SD_CLR}
  Result := CompareStr(S1, S2);
{$ELSE}
  Result := AnsiCompareStr(S1, S2);
{$ENDIF}
end;

function HelperCompareText(const S1, S2: string): Integer;
begin
{$IFDEF SD_CLR}
  Result := CompareText(S1, S2);
{$ELSE}
  Result := AnsiCompareText(S1, S2);
{$ENDIF}
end;

function VarIsStrType(const AValue: Variant): Boolean;
begin
  case VarType(AVa