⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 zdirmssql.pas

📁 控件名称：WINZEOS.ZIP 2002年08月03日 作者：CapellaDevelopment Zeos系列构件套件包含一组可直接存取Linux知名的免费数据库MySQL、Postgre
💻 PAS
📖 第 1 页 / 共 3 页
字号:
🔍
123 
{********************************************************}
{                                                        }
{                 Zeos Database Objects                  }
{                MS SQL direct class API                 }
{                                                        }
{       Copyright (c) 1999-2001 Sergey Seroukhov         }
{    Copyright (c) 1999-2001 Zeos Development Group      }
{                                                        }
{********************************************************}

unit ZDirMsSql;

interface

uses SysUtils, Classes, ZDirSql, ZLibMsSql, Db, ZTransact, ZSqlTypes, ZSqlExtra,
  Windows , DbTables;

{$INCLUDE ..\Zeos.inc}

type
  { Direct  MS Sql connection }
  TDirMsSqlConnect = class (TDirConnect)
  protected
    function GetErrorMsg: ShortString; override;
  public
    constructor Create;
    destructor  Destroy; override;

    procedure Connect; override;
    procedure Disconnect; override;
    procedure CreateDatabase(Params: string); override;
    procedure DropDatabase; override;
  end;

  { Direct MS Sql transaction }
  TDirMsSqlTransact = class (TDirTransact)
  private
    FHandle: PDBPROCESS;
    FLoginRec: PLOGINREC;
  protected
    function GetErrorMsg: ShortString; override;
  public
    constructor Create(AConnect: TDirMsSqlConnect);
    destructor Destroy; override;

    procedure Open; override;
    procedure Close; override;
    procedure StartTransaction; override;
    procedure EndTransaction; override;
    procedure Commit; override;
    procedure Rollback; override;

    property Handle: PDBPROCESS read FHandle;
    property LoginRec: PLOGINREC read FLoginRec;
  end;

  { Direct MS Sql query }
  TDirMsSqlQuery = class (TDirQuery)
  protected
    function GetErrorMsg: ShortString; override;
  public
    constructor Create(AConnect: TDirMsSqlConnect; ATransact: TDirMsSqlTransact);

    function  Execute: LongInt; override;

    procedure Open; override;
    procedure Close; override;
//    function  CreateBlobObject: TDirBlob; override;

    procedure ShowDatabases(DatabaseName: ShortString); override;
    procedure ShowTables(TableName: ShortString); override;
    procedure ShowColumns(TableName, ColumnName: ShortString); override;
    procedure ShowIndexes(TableName: ShortString); override;

    procedure Next; override;

    function  FieldCount: Integer; override;
    function  RecordCount: Integer; override;

    function  FieldName(FieldNum: Integer): ShortString; override;
    function  FieldSize(FieldNum: Integer): Integer; override;
    function  FieldMaxSize(FieldNum: Integer): Integer; override;
    function  FieldType(FieldNum: Integer): Integer; override;
    function  FieldDataType(FieldNum: Integer): TFieldType; override;
    function  FieldIsNull(FieldNum: Integer): Boolean; override;
    function  Field(FieldNum: Integer): string; override;
    function  FieldBuffer(FieldNum: Integer): PChar; override;

    function StringToSql(Value: string): string; override;
  end;

  { MS SQL stored proc }
  TDirMsSqlStoredProc = class(TDirStoredProc)
  private
    procedure BindParam(Param: TParam);
  protected
    function GetErrorMsg: ShortString; override;
  public
    constructor Create(AConnect: TDirMsSqlConnect; ATransact: TDirMsSqlTransact);

    procedure Prepare(Params: TParams); override;
    procedure UnPrepare; override;
    procedure ExecProc; override;
    procedure Open; override;
    procedure Close; override;
//    function  CreateBlobObject: TDirBlob; override;
    function GetReturnValue: string; override;

    procedure ShowStoredProcs; override;
    procedure ShowParams(StoredProcedureName: ShortString); override;

    procedure Next; override;

    function FieldCount: Integer; override;
    function RecordCount: Integer; override;
    function ParamCount: Integer; override;

    function FieldName(FieldNum: Integer): ShortString; override;
    function FieldSize(FieldNum: Integer): Integer; override;
    function FieldMaxSize(FieldNum: Integer): Integer; override;
    function FieldType(FieldNum: Integer): Integer; override;
    function FieldDataType(FieldNum: Integer): TFieldType; override;
    function FieldIsNull(FieldNum: Integer): Boolean; override;
    function Field(FieldNum: Integer): string; override;
    function FieldBuffer(FieldNum: Integer): PChar; override;

    { All param functions deal with returnparameters only }
    function ParamName(ParamNum: Integer): ShortString; override;
    function ParamSize(ParamNum: Integer): Integer; override;
    function ParamMaxSize(ParamNum: Integer): Integer; override;
    function ParamType(ParamNum: Integer): Integer; override;
    function ParamDataType(ParamNum: Integer): TFieldType; override;
    function ParamIsNull(ParamNum: Integer): Boolean; override;
    function Param(ParamNum: Integer): string; override;
    function ParamBuffer(ParamNum: Integer): PChar; override;

    function StringToSql(Value: string): string; override;
  end;

const
  { MsSql ParamTypes }
  SQL_PARAM_TYPE_UNKNOWN = 0;
  SQL_PARAM_TYPE_INPUT = 1;
  SQL_PARAM_TYPE_OUTPUT = 2;
  SQL_RESULT_COL = 3;
  SQL_PARAM_OUTPUT = 4;
  SQL_RETURN_VALUE =5;


{ MsSqlToDelphiParamType translates a MSSQL ParamType to a Delphi ParamType
  pre:   Value=MsSql ParamType to translate
  post:  Result=Delphi ParamType }
function MsSqlToDelphiParamType(Value: Integer): TParamType;
function DelphiToMsSqlType(const DelphiType: TFieldType): Integer;

{ Convert MS SQL field type to delphi field type }
function MsSqlToDelphiType(Value: Integer): TFieldType;

{ Convert MS SQL field types description to delphi field types }
function MsSqlToDelphiTypeDesc(Value: string): TFieldType;

{ Monitor list }
var MonitorList: TZMonitorList;

implementation

uses ZDBaseConst, ZExtra;

{***************** TDirMsSqlConnect implementation *****************}

{ Class constructor }
constructor TDirMsSqlConnect.Create;
begin
  inherited Create;
  Port := '1433';
end;

{ Class destructor }
destructor TDirMsSqlConnect.Destroy;
begin
  inherited Destroy;
end;

{ Get an error message }
function TDirMsSqlConnect.GetErrorMsg: ShortString;
begin
  if Status <> csOk then
  begin
    Result := dbsqlerror;
    if StrCmpBegin(Result, 'General SQL Server error') then
      Result := dbmessage;
  end else
    Result := '';
end;

{ Connect to database }
procedure TDirMsSqlConnect.Connect;
begin
  inherited Connect;
  if hDll = 0 then MsSqlLoadLib;
  SetStatus(csOk);
  SetActive(True);
end;

{ Disconnect from database }
procedure TDirMsSqlConnect.Disconnect;
begin
  SetStatus(csOk);
  SetActive(False);
end;

{ Create and connect to database }
procedure TDirMsSqlConnect.CreateDatabase(Params: string);
var
  FHandle: PDBPROCESS;
  FLoginRec: PLOGINREC;
  Temp: string;
  Buffer: string;
begin
  if Active then Disconnect;
  if hDll = 0 then MsSqlLoadLib;
  SetStatus(csFail);

  { creating Login struct }
  FLoginRec := dbLogin;
  if FLoginRec = nil then
  begin
    MonitorList.InvokeEvent(Format('CONNECT %s',[Database]), Error, True);
    Exit;
  end;
  Temp := Login;
  if dbsetluser(FLoginRec,PChar(Temp)) = DBFAIL then
  begin
    dbfreelogin(FLoginRec);
    MonitorList.InvokeEvent(Format('CONNECT %s',[Database]), Error, True);
    Exit;
  end;
  Temp := Passwd;
  if dbsetlpwd(FLoginRec,PChar(Temp)) = DBFAIL then
  begin
    dbfreelogin(FLoginRec);
    MonitorList.InvokeEvent(Format('CONNECT %s',[Database]), Error, True);
    Exit;
  end;
  dbsetlapp(FLoginRec, PChar(ExtractFileName(ParamStr(0))));
  Temp := HostName;
  { connect to the server }
  FHandle := ZLibMsSql.dbopen(FLoginRec, PChar(Temp));
  if FHandle <> nil then
  begin
    { must use master-table }
    dbuse(FHandle, 'Master');
    Buffer := 'CREATE DATABASE '+Database+' '+Params;
    dbcmd(FHandle, PChar(Buffer));
    dbsqlexec(FHandle);
    if dbresults(FHandle) <> DBFAIL then
    begin
      MonitorList.InvokeEvent(Buffer, 'OK.', False);
      SetStatus(csOK);
    end
    else
      MonitorList.InvokeEvent(Buffer, Error, True);
    ZLibMsSql.dbclose(FHandle);
  end
  else
    MonitorList.InvokeEvent(Format('CONNECT %s',[Database]), Error, True);

  dbfreelogin(FLoginRec);
end;

{ Drop current database }
procedure TDirMsSqlConnect.DropDatabase;
var
  FHandle: PDBPROCESS;
  FLoginRec: PLOGINREC;
  Temp: string;
  Buffer: string;
begin
  if Active then Disconnect;
  if hDll = 0 then MsSqlLoadLib;
  SetStatus(csFail);

  { creating Login struct }
  FLoginRec := dbLogin;
  if FLoginRec = nil then
  begin
    MonitorList.InvokeEvent(Format('CONNECT %s',[Database]), Error, True);
    Exit;
  end;
  Temp := Login;
  if dbsetluser(FLoginRec,PChar(Temp)) = DBFAIL then
  begin
    dbfreelogin(FLoginRec);
    MonitorList.InvokeEvent(Format('CONNECT %s',[Database]), Error, True);
    Exit;
  end;
  Temp := Passwd;
  if dbsetlpwd(FLoginRec,PChar(Temp)) = DBFAIL then
  begin
    dbfreelogin(FLoginRec);
    MonitorList.InvokeEvent(Format('CONNECT %s',[Database]), Error, True);
    Exit;
  end;
  dbsetlapp(FLoginRec,PChar(ExtractFileName(ParamStr(0))));
  Temp := HostName;
  { connect to the server }
  FHandle := ZLibMsSql.dbopen(FLoginRec, PChar(Temp));
  if FHandle <> nil then
  begin
    { must use master-table }
    dbuse(FHandle, 'Master');
    Buffer := 'DROP DATABASE ' + Database;
    dbcmd(FHandle, PChar(Buffer));
    dbsqlexec(FHandle);
    if dbresults(FHandle) <> DBFAIL then
    begin
      MonitorList.InvokeEvent(Buffer, 'OK.', False);
      SetStatus(csOK);
    end
    else
      MonitorList.InvokeEvent(Buffer, Error, True);
    ZLibMsSql.dbclose(FHandle);
  end
  else
    MonitorList.InvokeEvent(Format('CONNECT %s', [Database]), Error, True);

  dbfreelogin(FLoginRec);
end;

{ Class constructor }
constructor TDirMsSqlTransact.Create(AConnect: TDirMsSqlConnect);
begin
  inherited Create;
  Connect := AConnect;
  FHandle := nil;
  FLoginRec := nil;
end;

{ Class destructor }
destructor TDirMsSqlTransact.Destroy;
begin
  inherited Destroy;
end;

{ Get error message }
function TDirMsSqlTransact.GetErrorMsg: ShortString;
begin
  if Status <> csOk then
  begin
    Result := dbsqlerror;
    if StrCmpBegin(Result, 'General SQL Server error') then
      Result := dbmessage;
  end else
    Result := '';
end;

{ Disconnect from database }
procedure TDirMsSqlTransact.Open;
label
  ErrorProc;
var
  Temp: string;
begin
  inherited Open;
  SetStatus(csFail);
  if not Assigned(Connect) or not Connect.Active then
    Exit;

  { Allocate login record }
  FLoginRec := dblogin;
  if FLoginRec = nil then
    goto ErrorProc;
  { Setup login record }
  Temp := Connect.Login;
  if dbsetluser(FLoginRec, PChar(Temp)) = DBFAIL then
  begin
    dbfreelogin(FLoginRec);
    goto ErrorProc;
  end;
  Temp := Connect.Passwd;
  if dbsetlpwd(FLoginRec, PChar(Temp)) = DBFAIL then
  begin
    dbfreelogin(FLoginRec);
    goto ErrorProc;
  end;
  dbsetlapp(FLoginRec, PChar(ExtractFileName(ParamStr(0))));
  { Connect to database }
  Temp := Connect.HostName;
  FHandle := ZLibMsSql.dbopen(FLoginRec, PChar(Temp));
  if FHandle <> nil then
  begin
    dbsetopt(FHandle, DBTEXTLIMIT, '2147483647');
    dbsetopt(FHandle, DBTEXTSIZE, '2147483647');
    dbsqlexec(FHandle);
    while dbresults(FHandle) = DBSUCCEED do;

    Temp := Connect.Database;
    if dbuse(FHandle, PChar(Temp)) = DBFAIL then
    begin
      ZLibMsSql.dbclose(FHandle);
      FHandle := nil;
      goto ErrorProc;
    end;
    MonitorList.InvokeEvent(Format('CONNECT %s',[Connect.Database]), 'OK.', False);
  end else
    goto ErrorProc;

  StartTransaction;
  SetActive(Status = csOk);
  Exit;

  { Process error status }
ErrorProc:
  MonitorList.InvokeEvent(Format('CONNECT %s',[Connect.Database]), Error, True);
end;

{ Connect to database }
procedure TDirMsSqlTransact.Close;
begin
  EndTransaction;
  if Active then
  begin
    { Disconnect database }
    if FHandle <> nil then
    begin
      ZLibMsSql.dbclose(FHandle);
      FHandle := nil;
    end;
    { Free login record }
    if FLoginRec <> nil then
    begin
      dbfreelogin(FLoginRec);
      FLoginRec := nil;
    end;
    { Update transact status }
    if Assigned(Connect) then
      MonitorList.InvokeEvent(Format('DISCONNECT %s',[Connect.Database]), 'OK.', False);
  end;
  SetActive(False);
end;

{ Connect to database and start transaction }
procedure TDirMsSqlTransact.StartTransaction;
begin
  { Set startup values }
  SetStatus(csFail);
  if not Assigned(Connect) then Exit;
  SetStatus(csOk);
  { Begin transaction }
  if TransactSafe then
  begin
    dbcmd(FHandle, 'BEGIN TRANSACTION');
    dbsqlexec(FHandle);
    MonitorList.InvokeEvent('BEGIN TRANSACTION', Error, Error <> '');
    dbcancel(FHandle);
  end;
end;

{ End transaction and disconnect from database }
procedure TDirMsSqlTransact.EndTransaction;
begin
  { Setup transact properties }
  SetStatus(csOk);
  if Active then
  begin
    { End transaction }
    if TransactSafe then
    begin
      dbcmd(FHandle, 'ROLLBACK');
      dbsqlexec(FHandle);
      if dbresults(FHandle) <> DBSUCCEED then
        SetStatus(csFail);
      MonitorList.InvokeEvent('ROLLBACK', Error, Error <> '');
      dbcancel(FHandle);
    end;
  end;
end;

{ Commit transaction }
procedure TDirMsSqlTransact.Commit;
begin
  { Check status }
  SetStatus(csFail);
  if not Active or not Assigned(FHandle) then Exit;
  SetStatus(csOk);
  if TransactSafe then
  begin
    { Commit execute }
    dbcmd(FHandle, 'COMMIT');
    dbsqlexec(FHandle);
    if dbresults(FHandle) <> DBSUCCEED then
      SetStatus(csFail);
    MonitorList.InvokeEvent('COMMIT', Error, Error <> '');
    dbcancel(FHandle);
    { Start new trasaction }
    dbcmd(FHandle, 'BEGIN TRANSACTION');
    dbsqlexec(FHandle);
    if dbresults(FHandle) <> DBSUCCEED then
      SetStatus(csFail);
    dbcancel(FHandle);
    MonitorList.InvokeEvent('BEGIN TRANSACTION', Error, Error <> '');
  end;
end;

{ Rollback transaction }
procedure TDirMsSqlTransact.Rollback;
123

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -