zlibmssql.pas

控件名称：WINZEOS.ZIP 2002年08月03日 作者：CapellaDevelopment Zeos系列构件套件包含一组可直接存取Linux知名的免费数据库MySQL、Postgre

  dbsetopt              : Tdbsetopt;
  dbsettime             : Tdbsettime;
  dbsetuserdata         : Tdbsetuserdata;
  dbsqlexec             : Tdbsqlexec;
  dbsqlok               : Tdbsqlok;
  dbsqlsend             : Tdbsqlsend;
  dbstrcpy              : Tdbstrcpy;
  dbstrlen              : Tdbstrlen;
  dbtabbrowse           : Tdbtabbrowse;
  dbtabcount            : Tdbtabcount;
  dbtabname             : Tdbtabname;
  dbtabsource           : Tdbtabsource;
  dbtsnewlen            : Tdbtsnewlen;
  dbtsnewval            : Tdbtsnewval;
  dbtsput               : Tdbtsput;
  dbtxptr               : Tdbtxptr;
  dbtxtimestamp         : Tdbtxtimestamp;
  dbtxtsnewval          : Tdbtxtsnewval;
  dbtxtsput             : Tdbtxtsput;
  dbuse                 : Tdbuse;
  dbvarylen             : Tdbvarylen;
  dbwillconvert         : Tdbwillconvert;
//  dbwritepage           : Tdbwritepage;
  dbwritetext           : Tdbwritetext;
  dbupdatetext          : Tdbupdatetext;

function dbsqlerror: string;
function dboserror: string;
function dbmessage: string;

function MsSqlLoadLib: Boolean;

const
  DLL: string = DEFAULT_DLL_LOCATION;
  hDLL: THandle = 0;
  LibLoaded: Boolean = False;

implementation


uses SysUtils, ZDBaseConst;

{ Handle sql server errors }

const
  DbErrorCode: Integer = 0;
  OsErrorCode: Integer = 0;
  DbMsgCode: Integer = 0;
  DbError: string = '';
  OsError: string = '';
  DbMsg: string = '';

var
  OldErrorHandle: DBERRHANDLE_PROC = nil;
  OldMessageHandle: DBMSGHANDLE_PROC = nil;

{ Handle sql server error messages }
function ErrorHandle(Proc: PDBPROCESS; Severity, DbErr, OsErr: Integer;
  DbErrStr, OsErrStr: PChar): Integer; cdecl;
begin
  DbErrorCode := DbErr;
  OsErrorCode := OsErr;
  DbError := StrPas(DbErrStr);
  OsError := StrPas(OsErrStr);
  Result := 0;
end;

{ Handle sql server messages }
function MessageHandle(Proc: PDBPROCESS; MsgNo: DBINT; MsgState, Severity: Integer;
  MsgText, SrvName, ProcName: PChar; Line: DBUSMALLINT): Integer; cdecl;
begin
  DbMsgCode := MsgNo;
  DbMsg := StrPas(MsgText);
  Result := 0;
end;

function dbsqlerror: string;
begin
  Result := DbError;
end;

function dboserror: string;
begin
  Result := OsError;
end;

function dbmessage: string;
begin
  Result := DbMsg;
end;

{ Initialize MS SQL dynamic library }
function MsSqlLoadLib: Boolean;
begin
  if hDLL = 0 then
  begin
    hDLL := GetModuleHandle(PChar(DLL));
    LibLoaded := False;
    if hDLL = 0 then
    begin
      hDLL := LoadLibrary(PChar(DLL));
      LibLoaded := True;
    end;
  end;

  if hDLL <> 0 then
  begin
    @dberrhandle           := GetProcAddress(hDLL,'dberrhandle');
    @dbmsghandle           := GetProcAddress(hDLL,'dbmsghandle');
    @dbprocerrhandle       := GetProcAddress(hDLL,'dbprocerrhandle');
    @dbprocmsghandle       := GetProcAddress(hDLL,'dbprocmsghandle');
    @abort_xact            := GetProcAddress(hDLL,'abort_xact');
    @build_xact_string     := GetProcAddress(hDLL,'build_xact_string');
    @close_commit          := GetProcAddress(hDLL,'close_commit');
    @commit_xact           := GetProcAddress(hDLL,'commit_xact');
    @open_commit           := GetProcAddress(hDLL,'open_commit');
    @remove_xact           := GetProcAddress(hDLL,'remove_xact');
    @scan_xact             := GetProcAddress(hDLL,'scan_xact');
    @start_xact            := GetProcAddress(hDLL,'start_xact');
    @stat_xact             := GetProcAddress(hDLL,'stat_xact');
    @bcp_batch             := GetProcAddress(hDLL,'bcp_batch');
    @bcp_bind              := GetProcAddress(hDLL,'bcp_bind');
    @bcp_colfmt            := GetProcAddress(hDLL,'bcp_colfmt');
    @bcp_collen            := GetProcAddress(hDLL,'bcp_collen');
    @bcp_colptr            := GetProcAddress(hDLL,'bcp_colptr');
    @bcp_columns           := GetProcAddress(hDLL,'bcp_columns');
    @bcp_control           := GetProcAddress(hDLL,'bcp_control');
    @bcp_done              := GetProcAddress(hDLL,'bcp_done');
    @bcp_exec              := GetProcAddress(hDLL,'bcp_exec');
    @bcp_init              := GetProcAddress(hDLL,'bcp_init');
    @bcp_moretext          := GetProcAddress(hDLL,'bcp_moretext');
    @bcp_readfmt           := GetProcAddress(hDLL,'bcp_readfmt');
    @bcp_sendrow           := GetProcAddress(hDLL,'bcp_sendrow');
    @bcp_setl              := GetProcAddress(hDLL,'bcp_setl');
    @bcp_writefmt          := GetProcAddress(hDLL,'bcp_writefmt');
    @dbadata               := GetProcAddress(hDLL,'dbadata');
    @dbadlen               := GetProcAddress(hDLL,'dbadlen');
    @dbaltbind             := GetProcAddress(hDLL,'dbaltbind');
    @dbaltcolid            := GetProcAddress(hDLL,'dbaltcolid');
    @dbaltlen              := GetProcAddress(hDLL,'dbaltlen');
    @dbaltop               := GetProcAddress(hDLL,'dbaltop');
    @dbalttype             := GetProcAddress(hDLL,'dbalttype');
    @dbaltutype            := GetProcAddress(hDLL,'dbaltutype');
    @dbanullbind           := GetProcAddress(hDLL,'dbanullbind');
    @dbbind                := GetProcAddress(hDLL,'dbbind');
    @dbbylist              := GetProcAddress(hDLL,'dbbylist');
    @dbcancel              := GetProcAddress(hDLL,'dbcancel');
    @dbcanquery            := GetProcAddress(hDLL,'dbcanquery');
    @dbchange              := GetProcAddress(hDLL,'dbchange');
    @dbclose               := GetProcAddress(hDLL,'dbclose');
    @dbclrbuf              := GetProcAddress(hDLL,'dbclrbuf');
    @dbclropt              := GetProcAddress(hDLL,'dbclropt');
    @dbcmd                 := GetProcAddress(hDLL,'dbcmd');
    @dbcmdrow              := GetProcAddress(hDLL,'dbcmdrow');
    @dbcolbrowse           := GetProcAddress(hDLL,'dbcolbrowse');
    @dbcolinfo             := GetProcAddress(hDLL,'dbcolinfo');
    @dbcollen              := GetProcAddress(hDLL,'dbcollen');
    @dbcolname             := GetProcAddress(hDLL,'dbcolname');
    @dbcolsource           := GetProcAddress(hDLL,'dbcolsource');
    @dbcoltype             := GetProcAddress(hDLL,'dbcoltype');
    @dbcolutype            := GetProcAddress(hDLL,'dbcolutype');
    @dbconvert             := GetProcAddress(hDLL,'dbconvert');
    @dbcount               := GetProcAddress(hDLL,'dbcount');
    @dbcurcmd              := GetProcAddress(hDLL,'dbcurcmd');
    @dbcurrow              := GetProcAddress(hDLL,'dbcurrow');
    @dbcursor              := GetProcAddress(hDLL,'dbcursor');
    @dbcursorbind          := GetProcAddress(hDLL,'dbcursorbind');
    @dbcursorclose         := GetProcAddress(hDLL,'dbcursorclose');
    @dbcursorcolinfo       := GetProcAddress(hDLL,'dbcursorcolinfo');
    @dbcursorfetch         := GetProcAddress(hDLL,'dbcursorfetch');
    @dbcursorfetchex       := GetProcAddress(hDLL,'dbcursorfetchex');
    @dbcursorinfo          := GetProcAddress(hDLL,'dbcursorinfo');
    @dbcursorinfoex        := GetProcAddress(hDLL,'dbcursorinfoex');
    @dbcursoropen          := GetProcAddress(hDLL,'dbcursoropen');
    @dbdata                := GetProcAddress(hDLL,'dbdata');
    @dbdataready           := GetProcAddress(hDLL,'dbdataready');
    @dbdatecrack           := GetProcAddress(hDLL,'dbdatecrack');
    @dbdatlen              := GetProcAddress(hDLL,'dbdatlen');
    @dbdead                := GetProcAddress(hDLL,'dbdead');
    @dbexit                := GetProcAddress(hDLL,'dbexit');
//    @dbenlisttrans         := GetProcAddress(hDLL,'dbenlisttrans');
//    @dbenlistxatrans       := GetProcAddress(hDLL,'dbenlistxatrans');
//    @dbfcmd                := GetProcAddress(hDLL,'dbfcmd');
    @dbfirstrow            := GetProcAddress(hDLL,'dbfirstrow');
    @dbfreebuf             := GetProcAddress(hDLL,'dbfreebuf');
    @dbfreelogin           := GetProcAddress(hDLL,'dbfreelogin');
    @dbfreequal            := GetProcAddress(hDLL,'dbfreequal');
    @dbgetchar             := GetProcAddress(hDLL,'dbgetchar');
    @dbgetmaxprocs         := GetProcAddress(hDLL,'dbgetmaxprocs');
    @dbgetoff              := GetProcAddress(hDLL,'dbgetoff');
    @dbgetpacket           := GetProcAddress(hDLL,'dbgetpacket');
    @dbgetrow              := GetProcAddress(hDLL,'dbgetrow');
    @dbgettime             := GetProcAddress(hDLL,'dbgettime');
    @dbgetuserdata         := GetProcAddress(hDLL,'dbgetuserdata');
    @dbhasretstat          := GetProcAddress(hDLL,'dbhasretstat');
    @dbinit                := GetProcAddress(hDLL,'dbinit');
    @dbisavail             := GetProcAddress(hDLL,'dbisavail');
    @dbiscount             := GetProcAddress(hDLL,'dbiscount');
    @dbisopt               := GetProcAddress(hDLL,'dbisopt');
    @dblastrow             := GetProcAddress(hDLL,'dblastrow');
    @dblogin               := GetProcAddress(hDLL,'dblogin');
    @dbmorecmds            := GetProcAddress(hDLL,'dbmorecmds');
    @dbmoretext            := GetProcAddress(hDLL,'dbmoretext');
    @dbname                := GetProcAddress(hDLL,'dbname');
    @dbnextrow             := GetProcAddress(hDLL,'dbnextrow');
    @dbnullbind            := GetProcAddress(hDLL,'dbnullbind');
    @dbnumalts             := GetProcAddress(hDLL,'dbnumalts');
    @dbnumcols             := GetProcAddress(hDLL,'dbnumcols');
    @dbnumcompute          := GetProcAddress(hDLL,'dbnumcompute');
    @dbnumorders           := GetProcAddress(hDLL,'dbnumorders');
    @dbnumrets             := GetProcAddress(hDLL,'dbnumrets');
    @dbopen                := GetProcAddress(hDLL,'dbopen');
    @dbordercol            := GetProcAddress(hDLL,'dbordercol');
    @dbprocinfo            := GetProcAddress(hDLL,'dbprocinfo');
    @dbprhead              := GetProcAddress(hDLL,'dbprhead');
    @dbprrow               := GetProcAddress(hDLL,'dbprrow');
    @dbprtype              := GetProcAddress(hDLL,'dbprtype');
    @dbqual                := GetProcAddress(hDLL,'dbqual');
//    @dbreadpage            := GetProcAddress(hDLL,'dbreadpage');
    @dbreadtext            := GetProcAddress(hDLL,'dbreadtext');
    @dbresults             := GetProcAddress(hDLL,'dbresults');
    @dbretdata             := GetProcAddress(hDLL,'dbretdata');
    @dbretlen              := GetProcAddress(hDLL,'dbretlen');
    @dbretname             := GetProcAddress(hDLL,'dbretname');
    @dbretstatus           := GetProcAddress(hDLL,'dbretstatus');
    @dbrettype             := GetProcAddress(hDLL,'dbrettype');
    @dbrows                := GetProcAddress(hDLL,'dbrows');
    @dbrowtype             := GetProcAddress(hDLL,'dbrowtype');
    @dbrpcinit             := GetProcAddress(hDLL,'dbrpcinit');
    @dbrpcparam            := GetProcAddress(hDLL,'dbrpcparam');
    @dbrpcsend             := GetProcAddress(hDLL,'dbrpcsend');
    @dbrpcexec             := GetProcAddress(hDLL,'dbrpcexec');
    @dbrpwclr              := GetProcAddress(hDLL,'dbrpwclr');
//    @dbrpwset              := GetProcAddress(hDLL,'dbrpwset');
    @dbserverenum          := GetProcAddress(hDLL,'dbserverenum');
    @dbsetavail            := GetProcAddress(hDLL,'dbsetavail');
    @dbsetmaxprocs         := GetProcAddress(hDLL,'dbsetmaxprocs');
    @dbsetlname            := GetProcAddress(hDLL,'dbsetlname');
    @dbsetlogintime        := GetProcAddress(hDLL,'dbsetlogintime');
    @dbsetlpacket          := GetProcAddress(hDLL,'dbsetlpacket');
    @dbsetnull             := GetProcAddress(hDLL,'dbsetnull');
    @dbsetopt              := GetProcAddress(hDLL,'dbsetopt');
    @dbsettime             := GetProcAddress(hDLL,'dbsettime');
    @dbsetuserdata         := GetProcAddress(hDLL,'dbsetuserdata');
    @dbsqlexec             := GetProcAddress(hDLL,'dbsqlexec');
    @dbsqlok               := GetProcAddress(hDLL,'dbsqlok');
    @dbsqlsend             := GetProcAddress(hDLL,'dbsqlsend');
    @dbstrcpy              := GetProcAddress(hDLL,'dbstrcpy');
    @dbstrlen              := GetProcAddress(hDLL,'dbstrlen');
    @dbtabbrowse           := GetProcAddress(hDLL,'dbtabbrowse');
    @dbtabcount            := GetProcAddress(hDLL,'dbtabcount');
    @dbtabname             := GetProcAddress(hDLL,'dbtabname');
    @dbtabsource           := GetProcAddress(hDLL,'dbtabsource');
    @dbtsnewlen            := GetProcAddress(hDLL,'dbtsnewlen');
    @dbtsnewval            := GetProcAddress(hDLL,'dbtsnewval');
    @dbtsput               := GetProcAddress(hDLL,'dbtsput');
    @dbtxptr               := GetProcAddress(hDLL,'dbtxptr');
    @dbtxtimestamp         := GetProcAddress(hDLL,'dbtxtimestamp');
    @dbtxtsnewval          := GetProcAddress(hDLL,'dbtxtsnewval');
    @dbtxtsput             := GetProcAddress(hDLL,'dbtxtsput');
    @dbuse                 := GetProcAddress(hDLL,'dbuse');
    @dbvarylen             := GetProcAddress(hDLL,'dbvarylen');
    @dbwillconvert         := GetProcAddress(hDLL,'dbwillconvert');
//    @dbwritepage           := GetProcAddress(hDLL,'dbwritepage');
    @dbwritetext           := GetProcAddress(hDLL,'dbwritetext');
    @dbupdatetext          := GetProcAddress(hDLL,'dbupdatetext');

    OldErrorHandle := dberrhandle(ErrorHandle);
    OldMessageHandle := dbmsghandle(MessageHandle);

    Result := True;
  end else
    raise Exception.Create(Format(SLibraryNotFound,[DLL]));
end;

function DBSETLHOST(Login: PLOGINREC; ClientHost: PChar): RETCODE;
begin
  Result := dbsetlname(Login, ClientHost, DBSETHOST);
end;

function DBSETLUSER(Login: PLOGINREC; UserName: PChar): RETCODE;
begin
  Result := dbsetlname(Login, UserName, DBSETUSER);
end;

function DBSETLPWD(Login: PLOGINREC; Passwd: PChar): RETCODE;
begin
  Result := dbsetlname(Login, Passwd, DBSETPWD);
end;

function DBSETLAPP(Login: PLOGINREC; AppName: PChar): RETCODE;
begin
  Result := dbsetlname(Login, AppName, DBSETAPP);
end;

function DBSETLNATLANG(Login: PLOGINREC; Lang: PChar): RETCODE;
begin
  Result := dbsetlname(Login, Lang, DBSETLANG);
end;

function DBSETLSECURE(Login: PLOGINREC): RETCODE;
begin
  Result := dbsetlname(Login, nil, DBSETSECURE);
end;

function DBSETLVERSION(Login: PLOGINREC; Version: Byte): RETCODE;
begin
  Result := dbsetlname(Login, nil, Version);
end;

function DBSETLTIME(Login: PLOGINREC; Seconds: DWORD): RETCODE;
begin
  Result := dbsetlname(Login, PChar(Cardinal(Seconds)), DBSET_LOGIN_TIME);
end;

function DBSETLFALLBACK(Login: PLOGINREC; Fallback: PChar): RETCODE;
begin
  Result := dbsetlname(Login, Fallback, DBSETFALLBACK);
end;

function dbrbuf(Proc: PDBPROCESS): DBINT;
begin
  Result := DBINT(dbdataready(Proc));
end;

initialization

finalization
  if hDLL <> 0 then
  begin
    dberrhandle(OldErrorHandle);
    dbmsghandle(OldMessageHandle);
    if LibLoaded then
    begin
      dbexit;
      FreeLibrary(hDLL);
    end;
  end;
end.