搜索
bottom↓
回复: 15

上传点DELPHI7资料 希望大家有用 我一直在用的俄

[复制链接]

出0入0汤圆

发表于 2009-2-20 22:21:20 | 显示全部楼层 |阅读模式
Des 加密函数ourdev_421125.rar(文件大小:3K) (原文件名:Des.rar)
获取硬盘物理编号ourdev_421126.rar(文件大小:2K) (原文件名:GetDSN.rar)
MD5 加密函数ourdev_421127.rar(文件大小:3K) (原文件名:Md5.rar)
建立右下角任务栏图标ourdev_421128.rar(文件大小:1K) (原文件名:sysNotifyIcon.rar)
异或 字符串加密函数ourdev_421129.rar(文件大小:990字节) (原文件名:Ucrypt.rar)
获取网卡、操作系统版本、CPU的ID、BIOS信息等ourdev_421130.rar(文件大小:3K) (原文件名:VersionId.rar)

阿莫论坛20周年了!感谢大家的支持与爱护!!

一只鸟敢站在脆弱的枝条上歇脚,它依仗的不是枝条不会断,而是自己有翅膀,会飞。

出0入0汤圆

 楼主| 发表于 2009-2-20 22:26:35 | 显示全部楼层
//==================  2  =======================
//    如何实现执行一个程序并等待它完成
//
//      Filename:执行文件名
//      Params:执行参数
//      WindowState:窗口方式 03:最大化
//                            07:最小化
//                          其他:一般状态
//==============================================
function ExecAndWait(const Filename,Params:string;WindowState:word):boolean;
var
    SUInfo: TStartupInfo;
    ProcInfo: TProcessInformation;
    CmdLine: string;
begin
    CmdLine:=filename+' '+params;
    FillChar(SUInfo, SizeOf(SUInfo), #0);
    with SUInfo do
    begin
        cb := SizeOf(SUInfo);
        dwFlags := STARTF_USESHOWWINDOW;
        wShowWindow := WindowState;
    end;

    Result:=CreateProcess(NIL, PChar(CmdLine), NIL, NIL, FALSE,
            CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, NIL,
            PChar(ExtractFilePath(Filename)), SUInfo, ProcInfo);
    if Result then
    begin
        //等待应用程序结束
        WaitForSingleObject(ProcInfo.hProcess, INFINITE);
        //删除句柄
        CloseHandle(ProcInfo.hProcess);
        CloseHandle(ProcInfo.hThread);
    end;
end;

出0入0汤圆

 楼主| 发表于 2009-2-20 22:31:30 | 显示全部楼层
///====================================
///   动态加载动态连接库
///   P:定义一个函数变量
///     如 type Tproc=procedure(X:integer);stdcall;
///             var p:Tproc;
///   H:函数句柄 用于释放函数
///   FuncName:DLL中的函数名
///   DllPath:DLL文件名
///====================================

Function LoadDllFunc(var P:Pointer;
                         H:Thandle;
                         FuncName:string;
                         DllPath:string):boolean;
var
    path:string;
begin
    result:=false;
    if not findfilepath(path,dllpath) then
    begin
        showmessage('未找到 ['+dllpath+'] 动态链接库文件!');
        exit;
    end;
    H:=loadlibrary(pchar(path));

    if H<=0 then
    begin
        Raise Exception.Create
            ( '动态链接库 ['+dllpath+'] 调用失败,错误代码是:'+Inttostr(Getlasterror));
        exit;
    end else begin
        P:=getprocaddress(H,pchar(FuncName));
    end;
    if  not Assigned(P) then
    begin
        Raise Exception.Create
            ('GetProcAddress调用函数 ['+FuncName+'] 失败,错误代码是:'+inttostr(getlasterror));
        result:=false;
        exit;
    end;
    result:=true;
end;

出0入0汤圆

 楼主| 发表于 2009-2-20 22:33:55 | 显示全部楼层
///==============================================
///           查找一个相对路径的文件的绝对路径
///   GetPath:存放结果
///   PathStr:输入的文件路径
///==============================================
function FindFilePath(var GetPath:string;PathStr:string):boolean;
begin
    result:=false;
    getpath:=PathStr;

    ///默认路径
    DefaultDBPath:=trim(DefaultDBPath);
    if copy(defaultdbpath,length(defaultdbpath),1)<>'\' then  defaultdbpath:=defaultdbpath + '\';
    if FileExists(defaultdbpath + PathStr) then
    begin
        GetPath:=defaultdbpath + PathStr;
        result:=true;
        exit;
    end;

    ///程序运行路径
    if FileExists(AppPath + PathStr) then
    begin
        GetPath:=AppPath + PathStr;
        result:=true;
        exit;
    end;

    ///系统路径
    if FileExists(windir + Pathstr) then
    begin
        GetPath:=windir + Pathstr;
        result:=true;
        exit;
    end;
    ///系统路径
    if FileExists(sysdir + Pathstr) then
    begin
        GetPath:=sysdir + Pathstr;
        result:=true;
        exit;
    end;

    ///绝对路径
    if FileExists(PathStr) then
    begin
        GetPath:=PathStr;
        result:=true;
        exit;
    end;
end;

出0入0汤圆

 楼主| 发表于 2009-2-20 22:34:26 | 显示全部楼层
///==========================================
///           获取系统路径  SysDir
///==========================================
function sysdir:string;
var
    s:Pchar;
begin
    getmem(s,255);
    getsystemdirectory(s,255);
    result:=trim(s)+'\';
end;
///==========================================
///           获取系统路径  WinDir
///==========================================
function windir:string;
var
    s:Pchar;
begin
    getmem(s,255);
    getwindowsdirectory(s,255);
    result:=trim(s)+'\';
end;

出0入0汤圆

 楼主| 发表于 2009-2-20 22:37:27 | 显示全部楼层
{--------------------------------------------------------------}
{                         本地数据操作函数                     }
{                         Version:1.0                          }
{                         作者:knight                         }
{--------------------------------------------------------------}
unit myData;
interface
    uses
        Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
        IniFiles,StdCtrls,ADODB,Db,registry,DBClient,
        SConnect,uFindPath;
///1、access数据库操作
    function ADOCn(var conn:TADOConnection;                      ///连接ACCESS数据库
                       DBPath:string;
                       PWD:string='';
                       UID:string=''):boolean;stdcall;overload;  
    function AdoCn(var TSCn:TSocketConnection;                  ///局域网分布式数据库连接
                       DBpath:string;                                         
                       pwd:string='';
                       uid:string=''):boolean;overload;
    function ADORS(var cn:TADOConnection;                       ///执行SQL语句
                   var RS:TADOQuery;
                       SQLStr:string;
                       KeepConnect:boolean=false):boolean;stdcall;overload;

    function AdoRs(var TSCn:TSocketConnection;                 ///局域网分布式数据库SQL执行
                       ClientSet:TClientDataSet;
                       SQL:string;
                       KeepConnect:boolean=false):boolean;overload;
///2、ini 文件操作
    function readinifile(FilePath,Sectionstr,KeyStr:string;    ///读 ini 文件
                         mode:integer=0):variant; stdcall;
    function writeinifile(FilePath,Sectionstr,KeyStr:string;   ///写 ini 文件
                          values:variant;
                          mode:integer=0):boolean; stdcall;        
    procedure DelKey(FilePath,Sectionstr,KeyStr:string);      ///删除KEY
    procedure DelSection(filepath,sectionstr:string);         ///删除 段
    function  GetKeyList(filepath,sectionstr:string):tstrings;///获取所有KEY
    function  GetSectionList(filepath:string):tstrings;       ///获取所有 段
    function  GetLn(filepath,sectionstr:string):tstrings;     /// 获取段下的所有行
//3、txt文件操作
    function  WritetxtFile(Filepath:shortstring;              ///写文本文件
                           S:string;
                           OverWrite:boolean=false):boolean;
    function  Readtxtfile(filepath:shortstring):string;       ///读文本文件

///4、注册表操作
    Function  ReadReg(Root:hkey;path,key:string):string;      ///读注册表
    Function  WriteReg(Root:hkey;
                       path,key,val:string;
                       mode:byte=0):boolean;                  ///写注册表

var
    ServerName: string;
    ProviderName: string;
    dbport: integer;
    IsLanData: boolean;
    //data1,data2,data3: dbinfor;
    LanHostIP: string;
implementation
///1、access数据库操作
///=================================================
///             Access的  ADO 连接
///=================================================
function ADOCn(var Conn:TADOConnection;
                   DBPath:string;
                   PWD:string='';
                   UID:string=''):boolean;stdcall;overload;
var
    dbname:string;
begin
    result:=false;
    dbname:='';
    if FindFilePath(dbname,dbpath) then
    begin
        with conn do
        begin
            if Connected=true then  Connected:=false ;
            ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;'+
                              'Data Source='+dbname+';'+
                              'Persist Security Info=false;'+
                              'Jet OLEDB:Database Password='+PWD+';'+
                              'User ID='+UID+';mode=3';
            Try
              KeepConnection:=True;
              LoginPrompt:=false;
              Open;
              Result:=true;
            Except
              close;
              Result:=false;
            End;
        end;
    end
    else begin conn.Close; result:=false; end;
end;
function AdoCn(var TSCn:TSocketConnection;
                   DBpath:string;
                   pwd:string='';
                   uid:string=''):boolean;overload; //局域网分布式数据库连接
begin
    result:=false;
    TSCn.LoginPrompt:=false;
    TSCn.Connected:=false;
    if LanHostIP='' then LanHostIP:='127.0.0.1';
    TSCn.Address:=LanHostIP;
    if dbport<2 then dbport:=211;
    TSCn.Port:=dbport;
    if ServerName='' then ServerName:='SQLServer.SQLSvr';//com服务名
    TSCn.ServerName:=ServerName;
    try
        TSCn.Connected:=true;
        try
            TSCn.AppServer.SetDBName(dbpath,PWD,uid);
            result:=TSCn.Connected;
        except result:=false; end;
    except result:=false; end;
end;

///=================================================
///          Access的数据 SQL 语句操作
///=================================================
function ADORS(var cn:TADOConnection;
               var RS:TADOQuery;
               SQLStr:string;
               KeepConnect:boolean=false):boolean;stdcall;overload;

begin
    result:=false;
    with rs do
    begin
        Connection:=cn;
        SQL.Text:=SQLStr;
        Try
            if KeepConnect then open//返回结果
            else begin
                ExecSQL; //不返回结果
                close; cn.Close;
            end;
            Result:=true;
        Except
            close;
            cn.Close;
            Result:=false;
        End;
    end;
end;
function AdoRS(var TSCn:TSocketConnection;
                   ClientSet:TClientDataSet;
                   SQL:string;
                   KeepConnect:boolean=false):boolean;overload; //局域网分布式数据库SQL执行
begin
    result:=false;
    clientset.Active:=false;
    clientset.RemoteServer:=TSCn;
    if ProviderName='' then ProviderName:='DataSetProvider1';  //数据打包传输控件名
    clientset.ProviderName:=ProviderName;
    try
        TSCn.AppServer.SQLExecute(sql,'knight','qishiq',keepconnect);
        clientset.Active:=KeepConnect;
        result:=true;
    except
        result:=false;
    end;
end;

///2、ini 文件操作
///=================================================
///             写 ini 文件
///=================================================
function writeinifile(FilePath:string;
                      Sectionstr:string;
                      KeyStr:string;
                      values:variant;
                      mode:integer=0):boolean;stdcall;
var
    myinifile:tinifile;
    filename:string;
begin
    result:=false;
    findfilepath(filename,filepath);
    try
        myinifile:=TInifile.Create(filename);
    except
        exit;
    end;
    case mode of
        1:myinifile.writeinteger(SectionStr,KeyStr,Values);
        2:myinifile.writebool(SectionStr,KeyStr,Values);
    else
        myinifile.writestring(SectionStr,KeyStr,Values);
    end;
      myinifile.Destroy;
    result:=true;
end;
///=================================================
///             删除 KEY
///=================================================
procedure DelKey(FilePath:string;
                 Sectionstr:string;
                 KeyStr:string);
var
    myinifile:tinifile;
    filename:string;
begin
    filename:=FilePath;
    myinifile:=TInifile.Create(filename);
    myinifile.DeleteKey(Sectionstr,Keystr);
    myinifile.Destroy;
end;
///=================================================
///             删除 小节
///=================================================
procedure DelSection(filepath,sectionstr:string);
var
  myinifile:tinifile;
  filename:string;
begin
  filename:=FilePath;
  myinifile:=TInifile.Create(filename);
  myinifile.EraseSection(Sectionstr);
  myinifile.Destroy
end;
///=================================================
///             读 ini 文件
///=================================================
function readinifile(FilePath:string;
                    Sectionstr:string;
                    KeyStr:string;
                    mode:integer=0):variant; stdcall;
var
    myinifile:tinifile;
    filename:string;
    ReValue:variant;
begin
    if not findfilepath(filename,filepath) then
    begin
        case mode of
          1:Result:=0;
          2:Result:=false;
        else
          Result:='';
        end;
        exit;
    end;
    myinifile:=TInifile.Create(filename);
    case mode of
       1:ReValue:=myinifile.Readinteger(Sectionstr,Keystr,0);
       2:ReValue:=myinifile.Readbool(Sectionstr,Keystr,False);
       else
       ReValue:=myinifile.Readstring(Sectionstr,Keystr,'');
    end;

    myinifile.Destroy;
    Result:=ReValue;
end;
///=================================================
///         读一小节中的  所有关键字名
///=================================================
function GetKeyList(filepath,sectionstr:string):TStrings;
var
    myinifile:tinifile;
    filename:string;
    st:tstrings;
begin
    st:=tstringlist.Create;
    filename:=FilePath;
    myinifile:=TInifile.Create(filename);
    myinifile.readsection(Sectionstr,st);
    result:=st;
    myinifile.Destroy
end;
///=================================================
///    读一小节的 所有行(包括关键字、=、值)
///=================================================
function GetLn(filepath,sectionstr:string):TStrings;
var
  myinifile:tinifile;
  filename:string;
  st:tstrings;
begin
  st:=tstringlist.Create;
  filename:=FilePath;
  myinifile:=TInifile.Create(filename);
  myinifile.readsectionvalues(sectionstr,st);
  result:=st;
  myinifile.Destroy
end;
///=================================================
///          读INI文件中  所有小节名  
///=================================================
function GetSectionList(filepath:string):tstrings;
var
  myinifile:tinifile;
  filename:string;
  st:tstrings;
begin
  st:=tstringlist.Create;
  filename:=FilePath;
  myinifile:=TInifile.Create(filename);
  myinifile.readsections(st);
  result:=st;
  myinifile.Destroy
end;

///3、txt文件操作
///=================================================
///             写 txt文本文件
///         文档如果已经存在 则打开
///         如果不存在  则建立一个新的文档
///=================================================
function WritetxtFile(FilePath:shortstring;S:string;OverWrite:boolean=false):boolean;
var
    FileHandle: Integer;
    Buffer: PChar;
    wrLen: word;
    st: tstrings;
    i: integer;
    wstr: string;
    filename: string;
begin
    result:=false;
    wstr:='';
    if findfilepath(filename,filepath) then
    begin
        if OverWrite then
        begin
            try
                deletefile(filename);
            except
                EXIT;
            end;
            wstr:=s;
            FileHandle := FileCreate(FileName);
        end ELSE BEGIN
            st:=tstringlist.Create;
            st.LoadFromFile(filename);
            st.Add(s);
            for i:=0 to st.Count-1 do
            begin
                wstr:=wstr+st+char(13)+char(10);
            end;
            freeandnil(st);
            FileHandle := FileOpen(FileName, fmOpenReadWrite);
        END;
    end else begin
        WSTR:=S;
        FileHandle := FileCreate(FileName);
    end;

    if FileHandle < 0 then
    Begin
        Exit;
    End;

    WrLen:=length(wstr);
    GetMem(Buffer,WrLen+1);      ///分配一个 ?BYTE 的内存空间
    try
        StrPCopy(Buffer, wstr);  ///把文本拷贝到内存中
        FileWrite(FileHandle,Buffer^,WrLen);///把内存中的前 WrLen 个 BYTE 内容写进打开的文件中
    finally
        FreeMem(Buffer);
    end;
    FileClose(FileHandle);
    result:=true;
end;
///=================================================
///             读文本 很简单
///=================================================
function Readtxtfile(filePath:shortstring):string;
var
    ss:tstrings;
    s:string;
    i:integer;
    filename:string;
begin
    result:='';
    s:='';
    if not findfilepath(filename,filepath) then exit;
    ss:=tstringlist.Create;
    ss.LoadFromFile(filename); //uses Classes.pas
    for i:=0 to ss.Count-1 do
        s:=s+ss+char(13)+char(10);
    ss.Free;
    result:=s;
end ;

///4、注册表操作
///=================================================
///             读 注册表
///=================================================
Function ReadReg(Root:hkey;path,key:string):string;
var
    reg:Tregistry;
begin
    result:='';
    reg:=Tregistry.Create;
    reg.RootKey:=Root;
    if not reg.OpenKeyReadOnly(path) then
    begin reg.CloseKey; exit; end;
    result:=reg.ReadString(key);
    reg.CloseKey;
    reg.Free;
end;
///=================================================
///             写 注册表
///=================================================
Function writereg(Root:hkey;path,key,val:string;mode:byte=0):boolean;
var
    reg:Tregistry;  //当key='' 时 表示写入默认值
begin
    result:=false;
    reg:=Tregistry.Create;
    reg.RootKey:=Root;
    if not reg.OpenKey(path,true) then
    begin
        reg.CloseKey; exit;
    end;
    if mode=0 then
    begin
        reg.WriteString(key,val);
    end
    else if mode=1 then
    begin
        reg.WriteInteger(key,strtointdef(val,0));
    end
    else if mode=2 then
    begin
        reg.WriteFloat(key,strtofloatdef(val,0.0));
    end
    else if mode=3 then
    begin
        reg.WriteBool(key,strtobooldef(val,false));
    end;
    result:=true;
    reg.CloseKey;
    reg.Free;
end;

end.

出0入0汤圆

 楼主| 发表于 2009-2-20 22:45:09 | 显示全部楼层
我已经很少用OFFICE了一直是用WPS小巧而且官方宣称永久免费的ourdev_421137.rar(文件大小:172K) (原文件名:操作WPS表格.rar)
是根据官方的API写的 但是里面好多API函数使用不成功 不知道回事 只写了几个测试成功的函数
WPS的API ourdev_421142.rar(文件大小:1.08M) (原文件名:WPS_API.rar)
希望哪个高手把它全测试出来

出0入0汤圆

 楼主| 发表于 2009-2-20 22:48:02 | 显示全部楼层
制作资源文件
如果要把 图标文件(*.ico)、图片(*.jpg、*.bmp...)、excel文件(*.xls)...制作
则:
1、
mico    icon    icon.ico   
mico1   icon    icon01.ico  
micon   jpgfile icon.jpg   
Sample1 xlsfile Sample01.xls
Sample2 xlsFile Sample02.xls
Sample3 xlsFile Sample03.xls
mmax        bitmap  tomax.bmp   
mback        bitmap  toback.bmp  
mclose        bitmap  toclose.bmp
以上文字写入记事本,再存为 *.rc 文件(eg:aaa.rc)

2、
把   brcc32 aaa.rc
写入记事本,再存为 *.bat 批处理文件(eg:brcc32.bat)

3、
然后运行brcc32.bat 批处理文件,生成的 aaa.res 为资源文件

4、
在单元文件(*.pas)的 implementation 后 加入一下文字
     {$r aaa.RES}


提取资源文件

1、保存到硬盘
  uses
    classes;

  var
    res:tresourcestream;
  begin
    res:=tresourcestream.Create(hinstance,'Sample1',pchar('xlsfile'));
    res.SaveToFile(filepath);
    res.Free;
  end;


2、从资源文件中加载JPG图片
uses
   classes,jpeg;
var
   res:tresourcestream;
   Fjpg:TJpegImage;
begin
      fjpg:=TJpegImage.Create;
      res:=tresourcestream.Create(hinstance,'micon',pchar('jpgfile'));
      FJpg.LoadFromStream(res);
      image1.Picture.Bitmap.Assign(FJpg);
      FJpg.Free;
      res.Free;
end;

3、从资源文件中加载BMP图片
uses
   classes,Graphics;
begin
  image1.Picture.Bitmap.LoadFromResourceName(HInstance, 'mclose');
end;

4、从资源文件中加载程序系统图标
  Application.Icon.Handle := LoadIcon(HInstance, 'mIco1');

出0入0汤圆

发表于 2009-2-21 20:30:01 | 显示全部楼层
顶一下啊,虽然暂时用不上

出50入0汤圆

发表于 2009-3-30 15:31:38 | 显示全部楼层
好好的资料,但俺正在学, 请问楼主学Delphi 最主要就是学习Pasual,会Pasual就会简单的编程了呢? 另外有没有单独的Pascal的资料呀?

出0入0汤圆

发表于 2009-3-30 15:43:46 | 显示全部楼层
不错,很经典,顶一下。

出0入0汤圆

 楼主| 发表于 2009-3-30 22:36:05 | 显示全部楼层
delphi 的pascal 语言很简单的 和VB 都差不多的
开始主要是学DELPHI的VCL控件,就可以简单编程了

出0入0汤圆

发表于 2009-3-30 22:58:51 | 显示全部楼层
好资料!谢谢

出0入0汤圆

发表于 2009-3-30 23:04:32 | 显示全部楼层
Delphi是很博大精深的~不是拖拉控件那么简单的

出0入0汤圆

 楼主| 发表于 2009-3-30 23:15:05 | 显示全部楼层
初学 就是拖拉控件的

稍微熟练一点 就是精通使用个控件

高手就是自己编写 好用的控件

再高的人 就像李维 研究VCL核心, 他的一本书《深入核心VCL架构剖析》 ----让人实在是佩服!

其实都是围绕VCL架构的,博大精深也是在于此的,
但所使用的pascal语言其实是很简单的,没有C语言那么复杂
回帖提示: 反政府言论将被立即封锁ID 在按“提交”前,请自问一下:我这样表达会给举报吗,会给自己惹麻烦吗? 另外:尽量不要使用Mark、顶等没有意义的回复。不得大量使用大字体和彩色字。【本论坛不允许直接上传手机拍摄图片,浪费大家下载带宽和论坛服务器空间,请压缩后(图片小于1兆)才上传。压缩方法可以在微信里面发给自己(不要勾选“原图),然后下载,就能得到压缩后的图片】。另外,手机版只能上传图片,要上传附件需要切换到电脑版(不需要使用电脑,手机上切换到电脑版就行,页面底部)。
您需要登录后才可以回帖 登录 | 注册

本版积分规则

手机版|Archiver|amobbs.com 阿莫电子技术论坛 ( 粤ICP备2022115958号, 版权所有:东莞阿莫电子贸易商行 创办于2004年 (公安交互式论坛备案:44190002001997 ) )

GMT+8, 2024-5-20 19:44

© Since 2004 www.amobbs.com, 原www.ourdev.cn, 原www.ouravr.com

快速回复 返回顶部 返回列表