delphi：SQL Server导出数据到 EXCEL

Delphi数据库编程

下载此实例

开发语言：Pascal
实例大小：0.50M
下载次数：51
浏览次数：727
发布时间：2019-02-20
实例类别：Delphi数据库编程
发布人：charlie7407
文件格式：.rar
所需积分：2

相关标签：数据库 Excel c 导出导出excel

网友评论举报投诉收藏该页

下载此实例

实例介绍

[下载地址]

【实例简介】

【实例截图】

from clipboard

【核心代码】

unit CodeBox;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Grids, DBGrids, ComCtrls, Db, DBTables, DBCGrids, Mask, DBCtrls,
  ExtCtrls,INIFiles,comObj,ADODB,Menus;
Function Convert_Str(Temp_S:String):String;//将日期转换成 YYYY/MM/DD字符串
Function ConvertTimeToNum(H,M:String;ADD_Hour:Integer):Real;
Function ReturnFieldDataType(Field:TField):String;
Procedure ExportToExcel_01(aDataSet:TCustomADODataSet);
Procedure ExportToExcel_02(aDataSet:TCustomADODataSet);
function getclassname(tmpclass:string):tform;  //动态建立表单
function decryptstr(const s:string; skey:string):string;//解密
function encryptstr(const s:string; skey:string):string;//加密
function HexToStr(AStr: string): string;
function StrToHex(AStr: string): string;
function TransChar(AChar: Char): Integer;
function ReadHex(AString: string): integer;
Procedure ShowForm(FormName:String);
function IsWindowExists(form_1:string):boolean ;

implementation


function IsWindowExists(form_1:string):boolean ;
var com_count,i:integer;
begin
    com_count:=strtoint((inttostr(Application.ComponentCount)))-1;
    for i:=0 to com_count do
    begin
        if Application.Components[i].Name=form_1 then
          break;
    end;
    if i > com_count  then
      result:=false
    else
      result:=true;
end;



Procedure ShowForm(FormName:String);
var
    Findform:TForm;
    FindFormClass:TFormClass;
begin
   Findform:=TForm(FormName);
   FindFormClass:=TFormClass(FindClass('T' FormName));
   if FindFormClass<>Nil then
   Begin
      Application.CreateForm(FindformClass,FindForm);
      Findform.showModal;
   End;
end;

function ReadHex(AString: string): integer;
begin
    try
        Result:=StrToInt('$' AString);
    except
        Result:=0;
    end;
end;






function TransChar(AChar: Char): Integer;
begin
  if AChar in ['0'..'9'] then
   Result := Ord(AChar) - Ord('0')
  else
   Result := 10   Ord(AChar) - Ord('A');
end;


function StrToHex(AStr: string): string;
var
I : Integer;
begin
Result := '';
For I := 1 to Length(AStr) do
begin
Result := Result   Format('%2x', [Byte(AStr[I])]);
end;
I := Pos(' ', Result);
While I <> 0 do
begin
Result[I] := '0';
I := Pos(' ', Result);
end;
end;

function HexToStr(AStr: string): string;
var
I : Integer;
Charvalue: Word;
begin
Result := '';
For I := 1 to Trunc(Length(Astr)/2) do
begin
Result := Result   ' ';
Charvalue := TransChar(AStr[2*I-1])*16   TransChar(AStr[2
*I]);
Result[I] := Char(Charvalue);
end;
end;


function encryptstr(const s:string; skey:string):string;//加密
var
    i,j: integer;
    hexS,hexskey,midS,tmpstr:string;
    a,b,c:byte;
begin
    hexS   :=StrtoHex(s);
    hexskey:=StrtoHex(skey);
    midS   :=hexS;
    for i:=1 to (length(hexskey) div 2)   do
    begin
        if i<>1 then midS:= tmpstr;
        tmpstr:='';
        for j:=1 to (length(midS) div 2) do
        begin
            a:=strtoint('$' midS[2*j-1] midS[2*j]);
            b:=strtoint('$' hexskey[2*i-1] hexskey[2*i]);
            c:=a xor b;
            tmpstr := tmpstr StrtoHex(chr(c));
        end;
    end;
    result := tmpstr;
end;

function decryptstr(const s:string; skey:string):string;//解密
var
    i,j: integer;
    hexS,hexskey,midS,tmpstr:string;
    a,b,c:byte;
begin
    hexS :=s;//应该是该字符串
    if length(hexS) mod 2=1 then
    begin
        showmessage('密文错误！');
        exit;
    end;
    hexskey:=StrtoHex(skey);
    tmpstr :=hexS;
    midS   :=hexS;
    for i:=(length(hexskey) div 2) downto 1 do
    begin
        if i<>(length(hexskey) div 2) then midS:= tmpstr;
        tmpstr:='';
        for j:=1 to (length(midS) div 2) do
        begin
            a:=strtoint('$' midS[2*j-1] midS[2*j]);
            b:=strtoint('$' hexskey[2*i-1] hexskey[2*i]);
            c:=a xor b;
            tmpstr := tmpstr StrtoHex(chr(c));
        end;
    end;
    result := HextoStr(tmpstr);
end;






function getclassname(tmpclass:string):tform;
var
 cclass:tclass;
begin
 cclass:=getclass(tmpclass);//取得类名
 if cclass <>nil then   //如果这个类已经注册
   application.createform(tcomponentclass(cclass),result);//创建这个类的实例
end;



Procedure ExportToExcel_01(aDataSet:TCustomADODataSet);
var
   xlApp,xlBook,xlSheet,xlQuery: Variant;
begin
   xlApp := CreateOleObject('Excel.Application');
   xlBook := xlApp.Workbooks.Add;
   xlSheet := xlBook.Worksheets['sheet1'];
   xlApp.Visible := false;
   xlQuery := xlSheet.QueryTables.Add(aDataset.Recordset,xlSheet.Range['A1']); //??琌?
   xlQuery.FieldNames := True;
   xlQuery.RowNumbers := False;
   xlQuery.FillAdjacentFormulas := False;
   xlQuery.PreserveFormatting := True;
   xlQuery.RefreshOnFileOpen := False;
   xlQuery.BackgroundQuery := True;
   //xlQuery.RefreshStyle := xlInsertDeleteCells;
   xlQuery.SavePassword := True;
   xlQuery.SaveData := True;
   xlQuery.AdjustColumnWidth := True;
   xlQuery.RefreshPeriod := 0;
   xlQuery.PreserveColumnInfo := True;
   xlQuery.FieldNames := True;
   xlQuery.Refresh;
   xlApp.Visible := true;
End;

Procedure ExportToExcel_02(aDataSet:TCustomADODataSet);
var
   xlApp,xlBook,xlSheet: Variant;
   i:integer;
begin
   xlApp := CreateOleObject('Excel.Application');
   xlBook := xlApp.Workbooks.Add;
   xlSheet := xlBook.Worksheets['sheet1'];
   xlApp.Visible := True;
   For i:=0 to aDataSet.FieldCount-1 do
      xlsheet.cells[1,i 1]:=ADataset.Fields[i].FieldName;
   XLsheet.Cells[2,1].CopyFromRecordset(Adataset.Recordset,Adataset.RecordCount,Adataset.Fields.Count);
End;

Function ConvertTimeToNum(H:String;M:String;ADD_Hour:Integer):Real;
VAR Hour,Minute,c,c1:Integer;
Begin
   VAl(H,Hour,C);
   VAL(M,Minute,C1);
   RESULT:=(Hour ADD_HOUR)*60 Minute;
End;


Function Convert_Str(Temp_S:String):String;
VAR S_p,S1,S2,s3,Tempstr1:String;
    i,Code,j:Integer;
begin
      S_p:=Trim(Temp_s);
      i:=Pos('/',S_P);
      Tempstr1:=trim(Copy(S_p,i 1,Length(S_P)));
      j:=Pos('/',TempStr1);
      S2:=Copy(TempStr1,1,j-1);
      S3:=Trim(Copy(TempStr1,j 1,Length(TempStr1)-j));
      s1:=copy(s_p,1,4);
      Val(S2,i,Code);
      IF i<10 Then
      Begin
         Str(i,S2);
         S2:='0' Trim(S2);
      End;
      Val(S3,i,Code);
      IF i<10 Then
      Begin
         Str(i,S3);
         S3:='0' Trim(S3);
      End;
      S_p:=S1 '/' S2 '/' S3;
      Result:=S_P;
End;
Procedure   WriteINI(Var SSQL,SUser,Spwd,SDB:String);
Var
   INI:TIniFile;
Begin
   Ini.WriteString('SQL','SERVER',SSQL);
   Ini.WriteString('SQL','User',SUser);
   Ini.WriteString('SQL','Password',SPwd);
   Ini.WriteString('SQL','DATABASE',SDB);
End;
//********************************
//********************
Function ReturnFieldDataType(Field:TField):String;
Begin
   Case Field.DataType OF
         ftUnknown:
            Result:='ftUnknown';
         ftString:
            Result:='ftString';
         ftSmallint:
            Result:='ftSmallint';
         ftInteger:
            Result:='ftInteger';
         ftWord:
            Result:='ftword';
         ftBoolean:
            Result:='ftBoolean';
         ftFloat:
            Result:='ftFloat';
         ftCurrency:
            Result:='ftCurrency';
         ftBCD:
            Result:='ftBCD';
         ftDate:
            Result:='ftDate';
         ftTime:
            Result:='ftTime';
         ftDateTime:
            Result:='ftDateTime';
         ftBytes:
            Result:='ftBytes';
         ftVarBytes:
            Result:='ftVarBytes';
         ftAutoInc:
            Result:='ftAutoINC';
         ftBlob:
            Result:='ftBlob';
         ftMemo:
            Result:='ftMemo';
         ftGraphic:
            Result:='ftGraphic';
         ftFmtMemo:
            Result:='ftFmtMemo';
         ftParadoxOle:
            Result:='ftParadoxOle';
         ftDBaseOle:
            Result:='ftBaseOle';
         ftTypedBinary:
            Result:='fttypeBinary';
         ftCursor:
            Result:='ftCursor';
         ftFixedChar:
            Result:='ftFixedChar';
         ftWideString:
            Result:='ftWideString';
         ftLargeint:
            Result:='ftLargeint';
         ftADT:
            Result:='ftADT';
         ftArray:
            Result:='ftArray';
         ftReference:
            Result:='ftReference';
         ftDataSet:
            Result:='ftDataSet';
         ftOraBlob:
            Result:='ftORABlob';
         ftOraClob:
            Result:='ftOraclob';
         ftVariant:
            Result:='ftVariant';
         ftInterface:
            Result:='ftInterface';
         ftIDispatch:
            Result:='ftDispatch';
         ftGuid:
            Result:='ftGuid';
         ftTimeStamp:
            Result:='ftTimeStamp';
         ftFMTBcd:
            Result:='ftFmtBCD';
   end;
End;


end.

标签： 数据库 Excel c 导出导出excel

实例下载地址

delphi：SQL Server导出数据到 EXCEL

点此下载实例

不能下载？内容有错？点击这里报错 + 投诉 + 提问

好例子网口号：伸出你的我的手 — 分享！

网友评论

我要评论

小贴士

感谢您为本站写下的评论，您的评论对其它用户来说具有重要的参考价值，所以请认真填写。

类似“顶”、“沙发”之类没有营养的文字，对勤劳贡献的楼主来说是令人沮丧的反馈信息。
相信您也不想看到一排文字/表情墙，所以请不要反馈意义不大的重复字符，也请尽量不要纯表情的回复。
提问之前请再仔细看一遍楼主的说明，或许是您遗漏了。
请勿到处挖坑绊人、招贴广告。既占空间让人厌烦，又没人会搭理，于人于己都无利。

关于好例子网

本站旨在为广大IT学习爱好者提供一个非营利性互相学习交流分享平台。本站所有资源都可以被免费获取学习研究。本站资源来自网友分享，对搜索内容的合法性不具有预见性、识别性、控制性，仅供学习研究，请务必在下载后24小时内给予删除，不得用于其他任何用途，否则后果自负。基于互联网的特殊性，平台无法对用户传输的作品、信息、内容的权属或合法性、安全性、合规性、真实性、科学性、完整权、有效性等进行实质审查；无论平台是否已进行审查，用户均应自行承担因其传输的作品、信息、内容而可能或已经产生的侵权或权属纠纷等法律责任。本站所有资源不代表本站的观点或立场，基于网友分享，根据中国法律《信息网络传播权保护条例》第二十二与二十三条之规定，若资源存在侵权或相关问题请联系本站客服人员，点此联系我们。关于更多版权及免责申明参见版权及免责申明

delphi：SQL Server导出数据到 EXCEL

同类人气实例

实例介绍

实例下载地址

delphi：SQL Server导出数据到 EXCEL

相关软件

相关文章

网友评论

小贴士

关于好例子网

下载周排行

下载总排行