?? xadoex.pas

?? 很久以前用delphi寫的一個SQLServer外部的企業管理器
?? PAS
字號:
unit XADOEX;

interface
uses ADODB,Classes,DB,Variants,Grids,SysUtils,ActiveX,ComObj,UrlMon,Windows;


Procedure X_GetViewnames(cn:TADOConnection;List: TStrings;showtime:boolean);
Procedure X_Gettablenames(cn:TADOConnection;List: TStrings;showtime:boolean);
Procedure X_GetSystemtablenames(cn:TADOConnection;List: TStrings;showtime:boolean);
Procedure X_GetProcedureNames(cn:TADOConnection;List: TStrings;showtime:boolean);
Procedure X_GetFunctionNames(cn:TADOConnection;List: TStrings;showtime:boolean);
Procedure X_GetForeignKeysNames(cn:TADOConnection;List: TStrings);
Procedure X_GetPrimaryKeyNames(cn:TADOConnection;List: TStrings);
Procedure X_GetDBKeyWords(cn:TADOConnection;List: TStrings);
Procedure X_GetDBFieldsType(cn:TADOConnection;List: TStrings);
Procedure X_GetStruct(cn:TADOConnection;Grid:TStringGrid;tablename:string);
Function  CheckSQL(cn:TADOConnection;SQLStr:String):Boolean;overload;
Function  CheckSQL(cn:TADOConnection;SQLStr:array of String):Boolean;overload;

Procedure GetProcedureValue(cn:TADOConnection;Procname:string;ResultValue:TStrings);
Procedure ShowHTMLForm(H_WND:integer;Filename:String);
function ShowHTMLDialog(hwndParent: Cardinal;UrlMnk: IMoniker;
                        PvarArgIn: PVariantArg;PWCHOptions: PWChar;
                        PvarArgOut: PVariantArg): HRESULT; stdcall;external'MSHTML.DLL';


implementation

Procedure ShowHTMLForm(H_WND:integer;Filename:String);
var
  URLMoniker:IMoniker;
  VarArgs,VarReturn:TVariantArg;
  ArugStr,UrlStr,Return:String;
  POptions:PWChar;
begin
      Return:='';
      ArugStr:='';
      VarArgs.vt:=VT_BSTR;
      VarArgs.bstrVal:=StringToOleStr(ArugStr);
      POptions:='dialogHeight:23;dialogWidth:25;resizable:no;help:no;center:yes';;

      UrlStr:='file://'+Filename;
      OLECheck(CreateURLMoniker(nil,StringToOleStr(UrlStr),URLMoniker));
      VariantInit(OleVariant(VarReturn));
      ShowHTMLDialog(H_WND,URLMoniker,@VarArgs,POptions,@VarReturn);

end;

Procedure GetProcedureValue(cn:TADOConnection;Procname:string;ResultValue:TStrings);
var DataSet:TADODataSet;
    textField: TField;
begin
      if pos('SQLOLEDB',cn.Provider)<>0 then       //sql server數據庫
      begin
        try
         DataSet:=TADODataSet.Create(nil);
         DataSet.Connection:=cn;
         DataSet.CommandText:='sp_helptext "'+Procname+'";';
         DataSet.Open;
         textField:=DataSet.FieldByName('Text');
         ResultValue.clear;
         DataSet.First;
         while not DataSet.eof do
         begin
             ResultValue.Add(textField.AsString);
             DataSet.Next;
         end;
        finally
         DataSet.Free;
        end;
      end;
end;


Function  CheckSQL(cn:TADOConnection;SQLStr:array of String):Boolean;overload;
var i:integer;
begin
  Try
    
    for i:=0 to high(SQLStr) do
    begin
      cn.BeginTrans;
      CN.Execute(SQLStr[i]);
      cn.RollbackTrans;
    end;
    result:=true;

  except
    cn.RollbackTrans;
    result:=false;
  end;
end;

Function  CheckSQL(cn:TADOConnection;SQLStr:String):Boolean;
//var DataSet:TADODataSet;
begin
  Try
    cn.BeginTrans;
    CN.Execute(SQLStr);
    result:=true;
  except
    cn.RollbackTrans;
    result:=false;
  end;
{try
  DataSet:=TADODataSet.Create(nil);
  DataSet.Connection:=cn;
  DataSet.CommandText:=SQLStr;
 try
   DataSet.Open;
 except
   result:=false;
   exit;
 end;
   result:=true;
finally
  DataSet.Free;
end;  }

end;

Procedure X_GetStruct(cn:TADOConnection;Grid:TStringGrid;tablename:String);
var
  TableNameField, ColumnNameField,DataTypeField,IsNulLableField,
  ColumnDefauleField,CharacterOctetLengthField: TField;
  DataSet: TADODataSet;
  tempstr:string;
  GridIndex:integer;
begin
try

  tablename:=uppercase(tablename);
  DataSet := TADODataSet.Create(nil);
  cn.OpenSchema(siColumns, EmptyParam, EmptyParam, DataSet);
  TableNameField := DataSet.FieldByName('TABLE_NAME');
  ColumnNameField := DataSet.FieldByName('COLUMN_NAME');
  DataTypeField := DataSet.FieldByName('DATA_TYPE');
  IsNulLableField := DataSet.FieldByName('IS_NULLABLE');
  ColumnDefauleField := DataSet.FieldByName('COLUMN_DEFAULT');
  CharacterOctetLengthField := DataSet.FieldByName('CHARACTER_MAXIMUM_LENGTH');
  Grid.ColCount:=6;
  Grid.RowCount:=2;
  Grid.cells[0,0]:='序號';
  Grid.cells[1,0]:='字段名';
  Grid.cells[2,0]:='字段類型';
  Grid.cells[3,0]:='字段寬度';
  Grid.cells[4,0]:='是否為空';
  Grid.cells[5,0]:='默認值';

  GridIndex:=1;
  try
   while not DataSet.EOF do
      begin
        tempstr:=uppercase(TableNameField.AsString);
        if tempstr=tablename then
        begin
          Grid.RowCount:=grid.RowCount+1;
          Grid.Cells[0,GridIndex]:=inttostr(GridIndex); //寫入序號
          Grid.Cells[1,GridIndex]:=ColumnNameField.asString;
          Grid.Cells[2,GridIndex]:=DataTypeField.asString;
          Grid.Cells[3,GridIndex]:=CharacterOctetLengthField.asstring;
          Grid.Cells[4,GridIndex]:=IsNulLableField.asString;
          Grid.Cells[5,GridIndex]:=ColumnDefauleField.asString;
          inc(GridIndex);
        end;
       // List.Add(NameField.AsString);
        DataSet.Next;
      end;
     Grid.RowCount:=grid.RowCount-1;
   finally
   end;
finally
  DataSet.Free;
end;
end;

Procedure X_GetDBFieldsType(cn:TADOConnection;List: TStrings);
var
  FieldType,FieldNum: TField;
  DataSet: TADODataSet;
begin
try
 DataSet := TADODataSet.Create(nil);
  cn.OpenSchema(siProviderTypes, EmptyParam, EmptyParam, DataSet);
  FieldType := DataSet.FieldByName('TYPE_NAME');
  FieldNum:=DataSet.FieldByName('DATA_TYPE');
  List.BeginUpdate;
  try
   List.Clear;
   while not DataSet.EOF do
      begin
        List.Add(FieldType.AsString+'...'+FieldNum.asString);
        DataSet.Next;
      end;
   finally
     List.EndUpdate;
   end;
finally
  DataSet.Free;
end;
end;

Procedure X_GetDBKeyWords(cn:TADOConnection;List: TStrings);
var
  NameField: TField;
  DataSet: TADODataSet;
begin
try
 DataSet := TADODataSet.Create(nil);
  cn.OpenSchema(siDBInfoKeywords, EmptyParam, EmptyParam, DataSet);
  NameField := DataSet.FieldByName('Keyword');
  List.BeginUpdate;
  try
   List.Clear;
   while not DataSet.EOF do
      begin
        List.Add(NameField.AsString);
        DataSet.Next;
      end;
   finally
     List.EndUpdate;
   end;
finally
  DataSet.Free;
end;
end;


Procedure X_GetPrimaryKeyNames(cn:TADOConnection;List: TStrings);
var
  tablenamefield, NameField: TField;
  DataSet: TADODataSet;
begin
try
 DataSet := TADODataSet.Create(nil);
  cn.OpenSchema(siPrimaryKeys, EmptyParam, EmptyParam, DataSet);
  NameField := DataSet.FieldByName('COLUMN_NAME');
  tablenamefield:=dATASET.FIELDBYNAME('TABLE_NAME');
  List.BeginUpdate;
  try
   List.Clear;
   while not DataSet.EOF do
      begin
        List.Add(tablenamefield.AsString+'...'+NameField.AsString);
        DataSet.Next;
      end;
   finally
     List.EndUpdate;
   end;
finally
  DataSet.Free;
end;
end;

Procedure X_GetForeignKeysNames(cn:TADOConnection;List: TStrings);
var
  NameField: TField;
  DataSet: TADODataSet;
begin
try
 DataSet := TADODataSet.Create(nil);
  cn.OpenSchema(siForeignKeys, EmptyParam, EmptyParam, DataSet);
  NameField := DataSet.FieldByName('FK_NAME');
  List.BeginUpdate;
  try
   List.Clear;
   while not DataSet.EOF do
      begin
        List.Add(NameField.AsString);
        DataSet.Next;
      end;
   finally
     List.EndUpdate;
   end;
finally
  DataSet.Free;
end;
end;

Procedure X_GetViewnames(cn:TADOConnection;List:TStrings;showtime:boolean);
var
  TypeField, NameField,DateField: TField;
  TableType: string;
  DataSet: TADODataSet;
begin
  DataSet := TADODataSet.Create(nil);
  try
    cn.OpenSchema(siTables, EmptyParam, EmptyParam, DataSet);
     TypeField := DataSet.FieldByName('TABLE_TYPE');
     NameField := DataSet.FieldByName('TABLE_NAME'); { do not localize }
     DateField := DataSet.FieldByName('DATE_CREATED');
    List.BeginUpdate;
    try
      List.Clear;
      if showtime then
      begin
          while not DataSet.EOF do
          begin
            TableType := TypeField.AsString;
            if (TableType='VIEW') then
               List.Add(NameField.AsString+'...'+DateField.AsString);
            DataSet.Next;
          end;
      end
      else begin
           while not DataSet.EOF do
          begin
            TableType := TypeField.AsString;
            if (TableType='VIEW') then
               List.Add(NameField.AsString);
            DataSet.Next;
          end;
      end;

    finally
      List.EndUpdate;
    end;
  finally
    DataSet.Free;
  end;

end;

Procedure X_Gettablenames(cn:TADOConnection;List: TStrings;showtime:boolean);
var
  TypeField,NameField,DateField: TField;
  TableType: string;
  DataSet: TADODataSet;
begin
  DataSet := TADODataSet.Create(nil);
  try
    cn.OpenSchema(siTables, EmptyParam, EmptyParam, DataSet);
    TypeField := DataSet.FieldByName('TABLE_TYPE');
    NameField := DataSet.FieldByName('TABLE_NAME'); { do not localize }
    DateField := DataSet.FieldByName('DATE_CREATED');
    List.BeginUpdate;
    try
      List.Clear;
      if showtime then
      begin
          while not DataSet.EOF do
          begin
            TableType := TypeField.AsString;
            if (TableType='TABLE') then
               List.Add(NameField.AsString+'...'+DateField.AsString);
            DataSet.Next;
          end;
      end
      else begin
           while not DataSet.EOF do
          begin
            TableType := TypeField.AsString;
            if (TableType='TABLE') then
               List.Add(NameField.AsString);
            DataSet.Next;
          end;
      end;
    finally
      List.EndUpdate;
    end;
  finally
    DataSet.Free;
  end;

end;

Procedure X_GetSystemTablenames(cn:TADOConnection;List: TStrings;showtime:boolean);
var
  TypeField,NameField,DateField: TField;
  TableType: string;
  DataSet: TADODataSet;
begin
  DataSet := TADODataSet.Create(nil);
  try
    cn.OpenSchema(siTables, EmptyParam, EmptyParam, DataSet);
    TypeField := DataSet.FieldByName('TABLE_TYPE');
    NameField := DataSet.FieldByName('TABLE_NAME'); { do not localize }
    DateField := DataSet.FieldByName('DATE_CREATED');
    List.BeginUpdate;
    try
      List.Clear;
      if showtime then
      begin
          while not DataSet.EOF do
          begin
            TableType := TypeField.AsString;
            if (TableType='SYSTEM TABLE') then
               List.Add(NameField.AsString+'...'+DateField.AsString);
            DataSet.Next;
          end;
      end
      else begin
          while not DataSet.EOF do
          begin
            TableType := TypeField.AsString;
            if (TableType='SYSTEM TABLE') then
               List.Add(NameField.AsString);
            DataSet.Next;
          end;
      end;
    finally
      List.EndUpdate;
    end;
  finally
    DataSet.Free;
  end;

end;

Procedure X_GetFunctionNames(cn:TADOConnection;List: TStrings;showtime:boolean);
var
  NameField,DateField: TField;
  DataSet: TADODataSet;
  tempstr:String;
begin

  DataSet := TADODataSet.Create(nil);
  try
   cn.OpenSchema(siProcedures, EmptyParam, EmptyParam, DataSet);
   NameField := DataSet.FieldByName('PROCEDURE_NAME'); { do not localize }
   DateField := DataSet.FieldByName('DATE_CREATED');

   if showtime then
   begin
      while not DataSet.EOF do
      begin
         tempstr:=NameField.AsString;
         if copy(tempstr,Pos(';',tempstr)+1,length(tempstr)-pos(';',tempstr))='0' then
           List.Add(NameField.AsString+'...'+DateField.AsString);
        DataSet.Next;
      end;
   end
   else begin
      while not DataSet.EOF do
      begin
        tempstr:=NameField.AsString;
        if copy(tempstr,Pos(';',tempstr)+1,length(tempstr)-pos(';',tempstr))='0' then
           List.Add(NameField.AsString);
        DataSet.Next;
      end;
   end;
  finally
    DataSet.Free;
  end;
end;



Procedure X_GetProcedureNames(cn:TADOConnection;List: TStrings;showtime:boolean);
var
  NameField,DateField: TField;
  DataSet: TADODataSet;
  tempstr:String;
begin

  DataSet := TADODataSet.Create(nil);
  try
   cn.OpenSchema(siProcedures, EmptyParam, EmptyParam, DataSet);
   NameField := DataSet.FieldByName('PROCEDURE_NAME'); { do not localize }
   DateField := DataSet.FieldByName('DATE_CREATED');

   if showtime then
   begin
      while not DataSet.EOF do
      begin
        tempstr:=NameField.AsString;
        if copy(tempstr,Pos(';',tempstr)+1,length(tempstr)-pos(';',tempstr))<>'0' then
        begin
           List.Add(NameField.AsString+'...'+DateField.AsString);
        end;
        DataSet.Next;
      end;
   end
   else begin
      while not DataSet.EOF do
      begin
       tempstr:=NameField.AsString;
       if copy(tempstr,Pos(';',tempstr)+1,length(tempstr)-pos(';',tempstr))<>'0' then
           List.Add(NameField.AsString);
        DataSet.Next;
      end;
   end;
  finally
    DataSet.Free;
  end;
end;


end.
?? 文件大小 959 K
?? 上傳用戶 yamiluoier
?? 所屬分類 SQL Server
??? 相關標簽

#SQLServer #delphi #企業管理
?? 快捷鍵說明

復制代碼 Ctrl + C
搜索代碼 Ctrl + F
全屏模式 F11
切換主題 Ctrl + Shift + D
顯示快捷鍵 ?
增大字號 Ctrl + =
減小字號 Ctrl + -
亚洲欧美第一页_禁久久精品乱码_粉嫩av一区二区三区免费野_久草精品视频

?? xadoex.pas

?? 快捷鍵說明
