灯火互联
管理员
管理员
  • 注册日期2011-07-27
  • 发帖数41778
  • QQ
  • 火币41290枚
  • 粉丝1086
  • 关注100
  • 终身成就奖
  • 最爱沙发
  • 忠实会员
  • 灌水天才奖
  • 贴图大师奖
  • 原创先锋奖
  • 特殊贡献奖
  • 宣传大使奖
  • 优秀斑竹奖
  • 社区明星
阅读:8108回复:0

我的学习生涯(Delphi篇) - 01

楼主#
更多 发布于:2013-05-13 10:06

 Delphi中包装了几乎所有的WIN32 API。

   这些API至今还活跃在Windows平台!

   比如下文出现的 BlockRead/ BlockWrite就是调用IOPro函数。

   效果如下图:

Unit1.pas

[delphi]

unit Unit1;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, ShellApi, StdCtrls;

 

type

  TForm1 = class(TForm)

    Button1: TButton;

    Button2: TButton;

    Button3: TButton;

    Edit1: TEdit;

    Edit2: TEdit;

    Label1: TLabel;

    Label2: TLabel;

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

    procedure Button3Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  Form1: TForm1;

 

  procedure mycopyfile(Sfname,Dfname:string);

 

implementation

 

{$R *.dfm}

 

procedure TForm1.Button1Click(Sender: TObject);

var

  lphKey: HKEY;

  sKeyName: string;

  sKeyValue: string;

begin

    sKeyName := 'myfile';

    sKeyValue :='我的文档';

    RegCreateKey(HKEY_CLASSES_ROOT,pchar(sKeyName),lphKey);

    RegSetValue(lphKey,'',REG_SZ,pchar(sKeyValue),0);

    sKeyName := '.xbf';

    sKeyValue := 'myfile';

    RegCreateKey(HKEY_CLASSES_ROOT,pchar(sKeyName),lphKey);

    RegSetValue(lphKey,'',REG_SZ,pchar(sKeyValue),0);

    sKeyName := 'myfile';

    sKeyValue := 'e:\WINNT\SYSTEM32\NotePad.exe "%1"';

    RegCreateKey(HKEY_CLASSES_ROOT,pchar(sKeyName),lphKey);

    RegSetValue(lphKey,'shell\open\command',REG_SZ,pchar(sKeyValue),MAX_PATH);

 

end;

 

procedure TForm1.Button2Click(Sender: TObject);

begin

  //ShellExecute(Application.Handle,'open','NotePad.exe','',nil,SW_SHOWNORMAL);  

 

  //WinExec('command.com',SW_SHOWNORMAL);  

end;

 

 

 

procedure mycopyfile(Sfname,Dfname:string);

Var

  Sourcef,Destinef:file;

  NumRead,NumWritten:Integer;

  Buf:array[1..4096] of char;//定义缓冲区;  

Begin

  //Dfname:='c:\xiaobin.xbf';  

  AssignFile(Sourcef,Sfname);

  Reset(Sourcef,1);

  AssignFile(Destinef,Dfname);

  Rewrite(Destinef,1);

  Repeat

    BlockRead(Sourcef,Buf,SizeOf(Buf),Numread);//读源文件  

    BlockWrite(destinef,buf,NumRead,NumWritten);//写目标文件;  

  Until (Numread=0) or (Numwritten<>numread);

 

    //BlockRead(Sourcef,buf,SIZEOF(buf),NumRead);  

    //BlockWrite(Destinef,buf,NumRead,NumWritten);  

    closeFile(Sourcef);

    Closefile(destinef);

 

end;

 

 

procedure TForm1.Button3Click(Sender: TObject);

begin

  if  FileExists(Edit2.Text) then

  begin

    if Application.MessageBox('文件已经存在!是否覆盖?','提示',MB_YESNO)=IDYES then

    begin

      mycopyfile(Edit1.Text,Edit2.Text);

      //CopyFile('c:\xiaobin.xbf','d:\xiaobin.xbf',True);  

      Application.MessageBox('文件复制完成!','消息',32);

    end;

  end

  else

  begin

    mycopyfile(Edit1.Text,Edit2.Text);

    //CopyFile('c:\xiaobin.xbf','d:\xiaobin.xbf',True);  

    Application.MessageBox('文件复制完成!','消息',32);

  end;

  

end;

 

end.

unit Unit1;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, ShellApi, StdCtrls;

type

  TForm1 = class(TForm)

    Button1: TButton;

    Button2: TButton;

    Button3: TButton;

    Edit1: TEdit;

    Edit2: TEdit;

    Label1: TLabel;

    Label2: TLabel;

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

    procedure Button3Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

var

  Form1: TForm1;

 procedure mycopyfile(Sfname,Dfname:string);

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

var

  lphKey: HKEY;

  sKeyName: string;

  sKeyValue: string;

begin

    sKeyName := 'myfile';

    sKeyValue :='我的文档';

    RegCreateKey(HKEY_CLASSES_ROOT,pchar(sKeyName),lphKey);

    RegSetValue(lphKey,'',REG_SZ,pchar(sKeyValue),0);

    sKeyName := '.xbf';

    sKeyValue := 'myfile';

    RegCreateKey(HKEY_CLASSES_ROOT,pchar(sKeyName),lphKey);

    RegSetValue(lphKey,'',REG_SZ,pchar(sKeyValue),0);

    sKeyName := 'myfile';

    sKeyValue := 'e:\WINNT\SYSTEM32\NotePad.exe "%1"';

    RegCreateKey(HKEY_CLASSES_ROOT,pchar(sKeyName),lphKey);

    RegSetValue(lphKey,'shell\open\command',REG_SZ,pchar(sKeyValue),MAX_PATH);

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

  //ShellExecute(Application.Handle,'open','NotePad.exe','',nil,SW_SHOWNORMAL);

 //WinExec('command.com',SW_SHOWNORMAL);

end;

procedure mycopyfile(Sfname,Dfname:string);

Var

  Sourcef,Destinef:file;

  NumRead,NumWritten:Integer;

  Buf:array[1..4096] of char;//定义缓冲区;

Begin

  //Dfname:='c:\xiaobin.xbf';

  AssignFile(Sourcef,Sfname);

  Reset(Sourcef,1);

  AssignFile(Destinef,Dfname);

  Rewrite(Destinef,1);

  Repeat

    BlockRead(Sourcef,Buf,SizeOf(Buf),Numread);//读源文件

    BlockWrite(destinef,buf,NumRead,NumWritten);//写目标文件;

  Until (Numread=0) or (Numwritten<>numread);

   //BlockRead(Sourcef,buf,SIZEOF(buf),NumRead);

    //BlockWrite(Destinef,buf,NumRead,NumWritten);

    closeFile(Sourcef);

    Closefile(destinef);

end;

procedure TForm1.Button3Click(Sender: TObject);

begin

  if  FileExists(Edit2.Text) then

  begin

    if Application.MessageBox('文件已经存在!是否覆盖?','提示',MB_YESNO)=IDYES then

    begin

      mycopyfile(Edit1.Text,Edit2.Text);

      //CopyFile('c:\xiaobin.xbf','d:\xiaobin.xbf',True);

      Application.MessageBox('文件复制完成!','消息',32);

    end;

  end

  else

  begin

    mycopyfile(Edit1.Text,Edit2.Text);

    //CopyFile('c:\xiaobin.xbf','d:\xiaobin.xbf',True);

    Application.MessageBox('文件复制完成!','消息',32);

  end;

 

end;

end.


喜欢0 评分0
游客

返回顶部