注册 登陆
浏览模式: 标准 | 列表 分类: DELPHI

Delphi程序员的开发习惯

关开发习惯的一些想法,如鲠在喉,不吐不快。究其发贴动机,当然不排除有骗取参与分的可能,但另一方面,也希望能给同行(念Xing)者提供一些建议,或者参考(希望不是误人子弟)。同时,也希望各位能够就我的这些陋习,发表一点看法,给出批评和指正的意见。谢谢。


一.建立工程目录
     首先,第一步要做的,当然是给新项目建一个单独的目录(别笑)。目录名称与项目名称同名,或者另取一个也可,只要清楚、简练。然后,在此目录中创建以下各个目录:
    <Doc>:用来存放该项目相关的开发文档(需求说明,概要设计,详细设计等等等等);
    <Source>:用来存放Delphi源程序中的”.Dpr”,”.Pas”,”.Dfm”等文件;
    <Dcu>:该目录中存放”.Dcu”文件,将’.Pas’与’.Dcu’文件分开存放只是为了让Source目录的内容更加清楚一些;
    <Bin>:存放工程的输出文件,比如”.Exe”,”.Dll”或者”.Ocx”等等;
    <Log>:用来存放日志文件;通常在这个目录中我会放一个”<项目名称>程序员日志.Txt”文件。
    <Images>:当然是存放工程中用到的图片的目录了。一般情况下,这个目录是少不了的。假如还用到其他资源,那么也一样建立各自的目录,比如Wav,比如Avi等等。

二.设置工程选项
    在Delphi中创建一个新的工程,将此工程保存到Source目录中,同时:
a. 选一个耐看的,与项目有些联系的图标作为这个工程的图标。当然,这个图标可能只是临时用用的,但是总要比Delphi默认的那个难看的要好才行,要不然,怎么对得起自己?
b. 将Project Options -> Directories/Conditionals页面中的Output Directory设置为Bin目录;
c. 将Unit output Directory设置为Dcu目录。

三.添加常量单元
     添加一个新的Unit,另存为“unt<工程名> Consts.Pas”,用来保存工程中用到的常量。

四.有关窗体(Form)及单元(Unit)
     按照匈牙利命名法则给Form命名,则一个用来登录的窗体可以命名为’FrmLogin’,而其单元名可以为’untLogin’。通常,两个对应的Form和Unit的名称在除去’Frm’或’unt’的缩写后应当保持一致。
在Unit的头部添加本单元的注释,注释的格式可以参照Delphi的源码,但是至少应当包含以下几项:功能描述;作者;版权;创建时间;最后修改时间;修改历史等等。
将新创建好的Form的Caption设置为该Form类的名称,而不是使用Delphi默认的。比如,将Form1更名为FrmLogin后,此时我们获得了TFrmLogin这个新的窗体类,并且Delphi自动将窗体的Caption更新为’FrmLogin’。依我看,该Caption应当为’TFrmLogin’才是,因为我们在设计的是一个窗体类TFrmLogin,而不是仅仅对FrmLogin进行操作。
向TFrmLogin这样功能明确的窗体类,许多人都有在设计期就将其Caption设置为诸如“操作员登录”这种名称的习惯。我的习惯是,象“操作员登录”这样的常量,通常存放在unt<工程名>Consts.Pas中,用ResourceString来定义,或者用Const来定义。至于窗体的Caption的命名,应当属于运行期的工作。所以,我往往在TForm.OnCreate事件触发之时才对Caption进行操作,比如:
procedure TFrmLogin.FormCreate(Sender: TObject);
begin
        Caption := csLoginTitle;
       ....
end;

五.关于Format函数的使用
        有iYear,iMonth,iDay三个数据,要显示诸如“生日:1976/3/18”这样的信息,你通常怎么做?使用s := ‘生日:’+IntToStr(iYear)+’.’+IntToStr(iMonth)+’.’+IntToStr(iDay); 吗?这样实在是太累了。我的习惯是,在unt<工程名>Consts.Pas中增加一个常量csBirthDayFormat = ‘生日:%d/%d/%d’来保存显示格式,然后使用s := Format(csBirthDayFormat, [iYear, iMonth, iDay]);这样的语句完成数据的拼装。这么做的好处显而易见,那就是你只需在一个地方维护数据的显示格式。
        Format函数功能强大,我对它很是推崇,你呢?

六.关于注册表或者Ini文件的存储
原先访问注册表我通常使用TRegistry,而访问Ini文件通常使用TIniFile。这两个类的使用方法各不相同,因此想要使用相同的代码既能访问注册表又能访问Ini文件几乎是不可能的。真头疼啊!
终于我发现了救星!那就是TRegistryIniFile类。查看Registry单元,我们发现,TRegistryIniFile继承自TCusomIniFile。而TIniFile也是继承于TCusomIniFile。因此,使用抽象类TCusomIniFile来实现对注册表或者Ini文件的访问便是一举两得了。比如:
var
   csmIniFile: TCusomIniFile;
begin
   if blUseIniFile then//如果使用Ini文件
     csmIniFile:= TIniFile.Create(csRootKey)
   else
     csmIniFile:= TRegistryIniFile.Create(csRootKey);
   //接着就可以使用csmIniFile对Ini文件进行访问,
//或者用类似访问Ini文件的方式访问注册表。

七.关于TStream流以及TFileStream,TMemoryStream等等
        TFileStream和TMemoryStream都继承自抽象类TStream,这意味着我们可以使用一套代码完成对文件和内存的存取操作。因此,定义一些接口的时候,我往往倾向于将参数的类型定义为抽象类,而不是具体类。比如,要完成保存功能的一个函数,定义成
function Save(AStream: TStream): Boolean;
就比定义成
function Save(AStream: TFileStream): Boolean;
要灵活的多。
前一个定义是具有前瞻性的,因为它可以适用于以后可能出现的新型态的流。而后一个定义只适用于TFileStream这种流(当然包括TFileStream的子类),呆板多了。
我的习惯:如果存在抽象类,那么尽量将参数定义为抽象类的类型,毕竟,我们无法预见未来。

八.多使用TAction
        Delphi 4以后引入了Action的概念,并且在Standard组件栏中增加TActionList组件。使用Action的好处是,控件状态同步的烦恼从此一扫而空!

超短精简进制转换 (二进制/十进制/十六进制)

//十六进制(S)-->>十进制(I)    [重写:Jey]
function hextoint(s: string): Integer;
begin            //$代表16进制
    Result:=StrToInt('$'+s);
end;

//十进制转换为二进制字符串    [重写:Jey]
function inttoBin(i: integer): string;
begin
while i <>0 do
begin            //i mod 2取模,再使用format格式化
     result:=Format('%d'+result,[i mod 2]);
     i:=i div 2
end
end;

//二进制(S)-->>十进制(D)      [重写:Jey]
uses Math;
function hextoint(s: string): Double;
begin
    while Length(s) <>0 do
    begin            //2^(长度-1)次方
      if s[1]='1' then    Result:=Result+power(2,Length(s)-1);
      s:=Copy(s,2,Length(s));
    end
end;

//十进制(I)-->>十六进制(S)
//D自带函数,Digits长度,一般设4.
function IntToHex(Value: Integer; Digits: Integer): string;

//数据(S)-->>二进制(S)
//任何数据都是以二进制形式存储的! (转)
function conertde(s:string):string;
var
i:integer;
begin
for i:=1 to length(s) do
     result:=result+inttohex(ord(s[i]),2);
end;

Delphi编译指令说明

Delphi快速高效的编译器主要来自Object PASCAL的严谨,使用Delphi随时都在与编译器交流,大部分情况下不需要干涉编译器的运行,但是有时也需要对编译器进行必要的设置。

**********************************************************************************************

A.1 使用编译设置对话框

编译器的编译指令是用于指定编译器对项目编译过程的动作和行为。可以通过[Project]->[Options]->[Complier]选项页进行设置,绝大部分的编译环境都可以通过这一对话框进行调整,他包含了对代码、语法、调试信息等的设置。

1.代码设置(Code Generation)

Optimization: 代码优化开关

Aligned record fields: 字对齐数据。这个编译指令能够在变量和类型化常量的字节对齐和字对齐之间进行切换,其作用是全局的。

Stack frames: Windows 堆栈帧。其作用域是局部的,他使编译器成为远端过程和函数生成特定的开头和结尾代码。这个指令用于Windows 3.0的实模式,对所有Delphi应用程序他应该是关闭的。            

Pentium-safe FDIV: Pentium安全FDIV检查。此指令能够在Pentium处理器中指定编译器是否创建能够检测和使用有缺陷的浮点除法指令的代码。

2.运行期错误(Runtime Errors)

Range Checking: 范围检查。这个指令的作用范围是局部的,用于控制范围检验代码的生成。

I/O Checking: I/O检查。这个指令的作用域为局部,用来生成对一个文件的输入和输出过程和调用结果进行检查的代码。一般应该使其功能打开。

Overflos Checking: 溢出检查。其作用是生成对算术溢出检查的代码。

3.语法设置(Syntax Optings)

Strict Var- strings: 静态变量串开关。用来控制对以变量参数形式传递的串的类型检查。

Comlete Boolean Eval: 完全布尔表达量判定。用于执行强制的完整表达式判定。完全布尔量判定,有可能导致系统崩溃,所以一般不使用他。

Extended Syntax: 扩展语法开关。他能允许或禁止Delphi的扩展语法。

Typed @ Operator: 类型化的@运算符检查。应用于局部的变量引用上,控制@运算符返回的指针值类型。

Open Parameters: 开放参数开关。用于控制使用String关键字声明的变量参数。开放参数允许将大小不一的串变量传递到同一个过程或函数中,一般在汇编中会使用到。

Huge Strings: 字符串类型开关。用于控制Ansistring和Shortstring类型的切换。当打开时符合Ansistring,关闭时符合Shortstring。

Assignable Typed Constants: 可分配类型常量。用于向下与Delphi 1.0兼容。

4.调试(Debugging)

Debug Information: 调试信息开关。用于设置是否把调试信息写入以编译的单元文件(.dcu)。

Local Symbols: 局部符号开关。允许或禁止局部符号信息的创建。

Reference Info/Definitions Only: 符号信息开关。用于允许或禁止由Delohi的对象浏览器使用的符号引用信息的生成。

Assertions: 用于控制局部代码的属性。

Use Debug DCUs: 使用或禁止VCL的DCU文件调试。

5.信息(Messages)

Show Hints: 显示暗示。

Show Warnings: 显示警告。

**********************************************************************************************

A.2 使用编译指令

除了使用编译设置对话框对编译器进行设置外,还可以通过编译指令来对编译器进行设置。
对于局部的编译器设置,只有使用编译指令来完成。

对于开关编译指令,通过在编译指令后加入指示开关状态的加号和减号来控制编译器。例如:

{$B+} : 打开完全布尔量检查。
{$Q-} : 关闭溢出检查。

通常,编译指令的作用域是在编译指令后的代码部分,而对于全程的编译指令应该防在单元接口部分的开头。
编译设置对话框的设置都有与之对应的编译指令用于在代码中对编译器进行设置,如下表所示。

            设置项                         编译指令
                      
         Optimizations                       {$O}

         Aligned record fields               {$A}

         Stack frames                        {$W}

         Pentium-safe FDIV                   {$U}

         Range Checking                      {$R}

         I/O Checking                        {$I}

         Overflow Checking                   {$Q}  

         Strict Var-strings                  {$V}

         Comlete Boolean Eval                {$B}

         Extended Syntax                     {$X}

         Typed @ Operator                    {$T}

         Open Parameters                     {$P}

         Huge Strings                        {$H}

         Assertions typed constants          {$J}

         Debug information                   {$D}

         Local sysnbols                      {$L}

在这些编译指令以外还有一些非常有用的编译指令。
$R Filename    : 这个编译指令是最为常用的编译指令,他是资源文件编译指令,用于指定连接到执行文件和库的资源文件,例如在工程文件(.dpr)中会有{$R *.RES}的编译指令,表明把后缀为 .RES的与工程文件同名的资源文件连接入执行文件,也可以指定一个资源文件,资源文件的使用对于编写Windows程序来说是很重要的基础。

$I Filename :这个编译指令功能类似于C语言的#Include , 用于指定编译时包括的文件。

**********************************************************************************************

A.3 使用条件编译指令

条件编译指令是非常重要的编译指令,他控制着在不同条件下(例如,不同的操作系统)产生不同的代码。条件编译指令是包含在
注释括号之内的,如下表所示。
              
     条件编译指令        含义

       $DEFINE     用于定义一个条件符号,一旦定义,条件符号就为真

       $ELSE       与$IFDEF配合使用,如果$IFDEF条件为假,则只对源文件$ELSE后一小部分进行编译

       $ENDIF      结束一个以$IF开始的条件段
  
       $IFDEF      对条件符号进行判断,为真则编译源文件

       $IFNDEF     对条件符号进行判断,为假则编译源文件

       $IFOPT      根据编译开关状态,对源文件编译

       $UNDEF      撤消以前的条件符号定义

这些条件编译指令是非常有用的。例如,可以通过开关的状态来控制编译:

       {IFOPT R+}
           showmessage('Compiled with range-checking');
       {$ENDIF}

也可以通过定义条件符号来控制编译:
    
       {$Define s}
       ……
       {$ifdef s}
           showmessage('yes');
       {$else}
           showmessage('no');
       {$endif}

他的编译结果是显示'yes',但是如果省去{$Define s}则显示'no'。
在Delphi中已经预定义了一些关键的条件符号,如下表所示。

     条件符号             含义

      VERxx      编译器版本,XX表示版本,例如:Delphi 1.0 的编译器版本为80、Delphi 5.0 的编译器版本为130

      WIN32      是否WIN32的运行环境(Windows 95.98/NT/2000)

      CPU386     是否Intel386以上的处理器

      CONSOLE    是否控制台程序

Delphi的编译器指令除了以上的指令外还有一些,不过最为常用的指令已经全部介绍完了。对于普通的程序,Delphi是不需要编程者去添加编译器指令的,Delphi已经自动完成,但是要得到高品质的应用程序或者有特殊的要求的程序就必须熟悉Delphi的编译指令。Delphi不仅有最快的编译器而且编译器的功能也非常强大。

Delphi中的类和对象

谈谈Delphi中的类和对象
1.登不了大雅之堂地理解几个概念
    说到类和对象,我们不能不提及这样几个概念:类,对象,实例。就我个人觉得可
以这样来理解:对象指的是泛称,自然界的任何实体都可以看成一个对象;而类则是
以这些对象某些特征而分成的一系列的种类;实例则是特指属于某一个类的一个对象。
好啦,这些大道理我就不用多说了。不如来一个“背道而驰”的作法,我们用Delphi
code 来阐述这些外国人提出的一些令我们中国人不好理解的概念吧:
var
   ABtn:TButton;
定义ABtn是属于TButton类的一个对象,但ABtn不能说是一个实例,因为它还没有
被创建,所以我们说这是定义了一个对象,如果说定义了一个实例,多多少少有
一些不够确切。:)
begin
   ABtn:=TButton.Create(Self);//创建一个TButton的实例
   ABtn.Caption:='对象';
   ABtn.Free;
end;
2.对象是一个地地道道的指针
    从物理角度来看,对象就是一段地址空间,这段地址空间的标志就是我们定义的
类“变量”。所以我们可以把对象看成一个类的指针。大家知道,要访问一个指针就
必须对指针初始化。对象的既然是一个指针,也必须对它进行初始化。如何初始化呢?
还是说指针的初始化吧。对于一个指针可以有以下两种方法来进行初始化:
(一)直接分配
var
   Pint:^Integer;
begin
   new(Pint);
   Pint^:=12;
   Dispose(Pint);
end;
(二)指向别的已分配空间的变量
var
   Pint:^Integer;
   i:integer;
begin
   i:=12;
   Pint:=@i;
end;
有趣的是,对象这种“指针”也有两种方法初始化
(一)直接分配
var
   AForm:TForm;
begin
   AForm:=TForm.Create(Self);
   AForm.ShowModal;
   AForm.Free;
end;
(二)指向别的已分配空间的实例
var
   AForm:TForm;
begin
   AForm:=Self;
   AForm.Caption:='知道了吗?为什么会这样呢';
end;
file://这个AForm和它所指向的Form实例共用同一段地址单元,所有对AForm操作都将反应
file://到它所对应的Form实例之上。
说到这,我们就很好解释为什么过程(函数)的对象参数传递时,象这样这的格式:
(一)procedure SetEdit(var Edit:TEdit);
     begin
       Edit.Text:='11';
     end;

(二)procedure SetEdit(Edit:TEdit);
     begin
       Edit.Text:='11';
     end;
效果是一样的了。(一)是把一个TEdit实体作为参数引用的形式进行参数传递,(二)是
把一个TEdit的对象“指针”作为参数传递。

3.类可以理解成一种特殊的数据类型
     我们知道数据类型可以进行强制类型转化,类即然可以理解成一种数据类型,那
么它也应该可以进行类类型转。比方如下代码为一个按钮(Button1)的单击事件:
(一)
procedure TForm1.Button1Click(Sender: TObject);
var
   ACaption:String;
begin
   ACaption:=TButton(Sender).Caption;//Sender从TObject转化到TButton
   ShowMessage(Format('You clicked ''%s'' !',[ACaption]));
end;
在这段代码中,Sender是一个TObject型对象,我们把它强制转化为TButton类型。如你
看得不清楚,可以参照一下我们通常的数据类型的转化:
(二)
procedure TForm1.Button1Click(Sender: TObject);
var
   S_Str:String;
   P_Str:PChar;
begin
   S_Str:='I love China!';
   P_Str:=PChar(S_Str);
   S_Str:='';
   S_Str:=String(P_Str);
   ShowMessage(S_Str);
end;
但是在面对对象的程序设计过程中,强调的是安全性,如(一)的强制类型转化存在着不
安全性。如下的代码,依然是写Button1.OnClick事件:
(三)
procedure TForm1.Button1Click(Sender: TObject);
begin
   TCanvas(Sender).Brush.Color:=clRed;
end;
执行一下,就会出错。这样岂不是违背了面对对象的程序设计的宗旨了吗?没有,即然
是类,就应该有类特定的类强制转化方法,改(三)的方法如下:
(四)
procedure TForm1.Button1Click(Sender: TObject);
begin
   (Sender as TCanvas).Brush.Color:=clRed;
end;//用as来转化,as就可以把错误抓住,不会影响程序的正常运行。
说到这我顺便提一下VB吧,如果学过VB的人可能觉得其中的控件数组比较爽,尤其是在
编写象计算器这样的程序时。但Delphi给我们什么呢?答案是Delphi也能快速简洁的开
发出这样的程序。如是操作:在窗体上放一个Edit和十个Button,把Button.Caption分
别设为'0','1','2',...'9',然后写一个按钮的OnClick事件如下:
(五)
procedure TForm1.Button1Click(Sender: TObject);
begin
   Edit1.Text:=Edit1.Text+(Sender as TButton).Caption;
end;
把别的Button的OnClick事件都关联到Button1Click上,运行程序。拍拍手!这样计算器
程序的雏形就具备了。我们用Delphi的类类型转化,开发出来类似VB中的控件数组功能
的程序也是很棒的嘛!:)

4.抽象类和它的实例
     Delphi中有一种类为抽象类,你不能天真的直接为它创建一个实例。如:TStrings
类。如下代码:
(一)
var
   StrLst:TStrings;
begin
   StrLst:=TStrings.Create;
   StrLst.Add('I love Japan!');
   StrLst.Free;
end;
这是不对的。那如何为诸如TStrings这样的抽象类构造实例呢?答案是借助它的非抽
象子类。我们知道TStrings有一个TStringList非抽象子类。我们就可以这样作:
(二)
var
   StrLst:TStrings;
begin
   StrLst:=TStringList.Create;//借助其子类的构造器,对StrLst进行子类化
   StrLst.Add('I love China!');
   StrLst.Free;
end;
(三)
var
   StrLst:TStringList;
begin
   StrLst:=TStringList.Create;
file://放弃吧,不要再用抽象类,完全用它的“儿子”来你的事吧  
   StrLst.Add('I love China!');
   StrLst.Free;
end;

5.类是一种对数据和操作高度的封装机制
(一)数据封装
unit Unit2;

interface
type
   TEmployee=class
   private
     FName:String;
   public
     Constructor Create;
     function   GetName:String;
     procedure SetName(AName:String);
   end;
implementation

{ TEmployee }

constructor TEmployee.Create;
begin
   FName:='BlazingFire';
end;

function TEmployee.GetName: String;
begin
   Result:=FName;
end;

procedure TEmployee.SetName(AName: String);
begin
   FName:=AName;
end;

end.
如上代码,我们就用了一个过程SetName和一个函数GetName对私有变量FName进行完全的
封装。我们要对FName操作就只有这样:
uses
   unit2;
procedure TForm1.Button1Click(Sender: TObject);
var
   AEmployee:TEmployee;
begin
   AEmployee:=TEmployee.Create;
   AEmployee.SetName('Rose');//利用SetName来设置FName
   MessageBox(Handle,PChar(AEmployee.GetName),'Empoyee',0);
  file://用GetName来访问FName
   AEmployee.Free;
end;
(二)操作封装
unit Unit2;

interface
type
   TDivision=Class
   public
    file://多态性让你的程序更据有“柔韧性”
     function GetDiv(Num1,Num2:Double):Double;overload;
     function GetDiv(Num1,Num2:integer):integer;overload;
   end;
implementation

{ Division }

function TDivision.GetDiv(Num1, Num2: Double): Double;
begin
   try
     Result:=Num1/Num2;
   except
     Result:=0;//提供弹形处理机制,处理除数为0情况
   end;
end;

function TDivision.GetDiv(Num1, Num2: integer): integer;
begin
   try
     Result:=Num1 div Num2;
   except
     Result:=0;//提供弹形处理机制,处理除数为0情况
   end;
end;

end.
如上代码我们通过类的多态性机制把除法分别处理成整除和非整除,又通过异常处理屏
去除数为0的情况,从而保证操作的安全性,在调用时,我们就可以这样来:
uses
   unit2;
{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
   Division:TDivision;
   IValue:integer;
   FValue:Double;
begin
   Division:=TDivision.Create;
   IValue:=Division.GetDiv(1,2);
   FValue:=Division.GetDiv(1.0,2);
   IValue:=Division.GetDiv(1,0);
   FValue:=Division.GetDiv(1.0,0);
   Division.Free;
end;

6.类是一种代码重用机制
     比方在5中我们想对这个类加上一个GetAdd函数来作加法运算就可以用类的继承。如
下写就可以了:
(一)
unit Unit2;

interface
type
   TDivision=Class
   public
     function GetDiv(Num1,Num2:Double):Double;overload;
     function GetDiv(Num1,Num2:integer):integer;overload;
   end;
type
   TOperation=Class(TDivision)
   public
     function GetAdd(Num1,Num2:Double):Double;
   end;
implementation

{ Division }

function TDivision.GetDiv(Num1, Num2: Double): Double;
begin
   try
     Result:=Num1/Num2;
   except
     Result:=0;
   end;
end;

function TDivision.GetDiv(Num1, Num2: integer): integer;
begin
   try
     Result:=Num1 div Num2;
   except
     Result:=0;
   end;
end;

{ TOperation }

function TOperation.GetAdd(Num1, Num2: Double): Double;
begin
   Result:=Num1+Num2;
end;

end.
这里我们从TDivision继承了一个子类TOperation。TOperation就可以即有TDivsion
公有方法GetDiv,又有自己的独特的方法GetAdd。这是类为我们提供的“鱼和熊掌兼
得”之法。不错吧。:)

MediaPlayer9 ActiveX 攻略

MediaPlayer9 ActiveX 攻略 巨强悍 文章量大

» 阅读全文

Delphi BORdbk70错误

Debugger Kernel BORDBK70.DLL is missing or not registered.

开始运行输入

regsvr32  "X:\Program Files\Common Files\Borland Shared\Debugger\BORdbk70.dll"

即可

用Delphi实现远程屏幕抓取

---- 在网络管理中,有时需要通过监视远程计算机屏幕来了解网上微机的使用情况。虽然,市面上有很多软件可以实现该功能,有些甚至可以进行远程控制,但在使用上缺乏灵活性,如无法指定远程计算机屏幕区域的大小和位置,进而无法在一屏上同时监视多个屏幕。其实,可以用Delphi自行编制一个灵活的远程屏幕抓取工具,简述如下。

---- 一、软硬件要求。

---- Windows95/98对等网,用来监视的计算机(以下简称主控机)和被监视的计算机(以下简称受控机)都必须装有TCP/IP 协议,并正确配置。如没有网络,也可以在一台计算机上进行调试。

---- 二、实现方法。

---- 编制两个应用程序,一个为VClient.exe,装在受控机上,另一个为VServer.exe,装在主控机上。VServer.exe指定要监视的受控机的IP地址和将要在受控机屏幕上抓取区域的大小和位置,并发出屏幕抓取指令给VClient.exe,VClient.exe得到指令后,在受控机屏幕上选取指定区域,生成数据流,将其发回主控机,并在主控机上显示出抓取区域的BMP图象。由以上过程可以看出,该方法的关键有二:一是如何在受控机上进行屏幕抓取,二是如何通过TCP/IP协议在两台计算机中传输数据。

---- UDP(User Datagram Protocol,意为用户报文协议)是Internet上广泛采用的通信协议之一。与TCP协议不同,它是一种非连接的传输协议,没有确认机制,可靠性不如TCP,但它的效率却比TCP高,用于远程屏幕监视还是比较适合的。同时,UDP控件不区分服务器端和客户端,只区分发送端和接收端,编程上较为简单,故选用UDP协议,使用Delphi 4.0提供的TNMUDP控件。

---- 三、创建演示程序。

---- 第一步,编制VClient.exe文件。新建Delphi工程,将默认窗体的Name属性设为“Client”。加入TNMUDP控件,Name属性设为“CUDP”;LocalPort属性设为“1111”,让控件CUDP监视受控机的1111端口,当有数据发送到该口时,触发控件CUDP的OnDataReceived事件;RemotePort属性设为“2222”,当控件CUDP发送数据时,将数据发到主控机的2222口。

---- 在implementation后面加入变量定义

const BufSize=2048;{ 发送每一笔数据的缓冲区大小 }
var
  BmpStream:TMemoryStream;
  LeftSize:Longint;{ 发送每一笔数据后剩余的字节数 }

为Client的OnCreate事件添加代码:
procedure TClient.FormCreate(Sender: TObject);
begin
  BmpStream:=TMemoryStream.Create;
end;

为Client的OnDestroy事件添加代码:
procedure TClient.FormDestroy(Sender: TObject);
begin
  BmpStream.Free;
end;

为控件CUDP的OnDataReceived事件添加代码:
procedure TClient.CUDPDataReceived(Sender: TComponent;
  NumberBytes: Integer; FromIP: String);
var
  CtrlCode:array[0..29] of char;
  Buf:array[0..BufSize-1] of char;
  TmpStr:string;
  SendSize,LeftPos,TopPos,RightPos,BottomPos:integer;
begin
  CUDP.ReadBuffer(CtrlCode,NumberBytes);{ 读取控制码 }
  if CtrlCode[0]+CtrlCode[1]+CtrlCode[2]+CtrlCode[3]=show then
  begin { 控制码前4位为“show”表示主控机发出了抓屏指令 }
if BmpStream.Size=0 then { 没有数据可发,必须截屏生成数据 }
    begin
TmpStr:=StrPas(CtrlCode);
TmpStr:=Copy(TmpStr,5,Length(TmpStr)-4);
LeftPos:=StrToInt(Copy(TmpStr,1,Pos(:,TmpStr)-1));
TmpStr:=Copy(TmpStr,Pos(:,TmpStr)+1,Length(TmpStr)
-Pos(:,TmpStr));
TopPos:=StrToInt(Copy(TmpStr,1,Pos(:,TmpStr)-1));
TmpStr:=Copy(TmpStr,Pos(:,TmpStr)+1,Length(TmpStr)-
Pos(:,TmpStr));
RightPos:=StrToInt(Copy(TmpStr,1,Pos(:,TmpStr)-1));
BottomPos:=StrToInt(Copy(TmpStr,Pos(:,TmpStr
)+1,Length(TmpStr)-Pos(:,TmpStr)));
ScreenCap(LeftPos,TopPos,RightPos,BottomPos); {
截取屏幕 }
    end;
if LeftSize>BufSize then SendSize:=BufSize
else SendSize:=LeftSize;
BmpStream.ReadBuffer(Buf,SendSize);
LeftSize:=LeftSize-SendSize;
if LeftSize=0 then BmpStream.Clear;{ 清空流 }
CUDP.RemoteHost:=FromIP; { FromIP为主控机IP地址 }
CUDP.SendBuffer(Buf,SendSize); { 将数据发到主控机的2222口 }
  end;
end;

其中ScreenCap是自定义函数,截取屏幕指定区域,
代码如下:
procedure TClient.ScreenCap(LeftPos,TopPos,
RightPos,BottomPos:integer);
var
  RectWidth,RectHeight:integer;
  SourceDC,DestDC,Bhandle:integer;
  Bitmap:TBitmap;
begin
  RectWidth:=RightPos-LeftPos;
  RectHeight:=BottomPos-TopPos;
  SourceDC:=CreateDC(DISPLAY,,,nil);
  DestDC:=CreateCompatibleDC(SourceDC);
  Bhandle:=CreateCompatibleBitmap(SourceDC,
RectWidth,RectHeight);
  SelectObject(DestDC,Bhandle);
  BitBlt(DestDC,0,0,RectWidth,RectHeight,SourceDC,
LeftPos,TopPos,SRCCOPY);
  Bitmap:=TBitmap.Create;
  Bitmap.Handle:=BHandle;
  BitMap.SaveToStream(BmpStream);
  BmpStream.Position:=0;
  LeftSize:=BmpStream.Size;
  Bitmap.Free;
  DeleteDC(DestDC);
  ReleaseDC(Bhandle,SourceDC);
end;
存为“C:\VClient\ClnUnit.pas”和“C:\VClient\VClient.dpr”,
并编译。


---- 第二步,编制VServer.exe文件。新建Delphi工程,将窗体的Name属性设为“Server”。加入TNMUDP控件,Name属性设为“SUDP”;LocalPort属性设为“2222”,让控件SUDP监视主控机的2222端口,当有数据发送到该口时,触发控件SUDP的OnDataReceived事件;RemotePort属性设为“1111”,当控件SUDP发送数据时,将数据发到受控机的1111口。加入控件Image1,Align属性设为“alClient”;加入控件Button1,Caption属性设为“截屏”;加入控件Label1,Caption属性设为“左:上:右:下”;加入控件Edit1,Text属性设为“0:0:100:100”;加入控件Label2,Caption属性设为“受控机IP地址”;加入控件Edit2,Text属性设为“127.0.0.1”;
在implementation后面加入变量定义
const BufSize=2048;
var
  RsltStream,TmpStream:TMemoryStream;

为Server的OnCreate事件添加代码:
procedure TServer.FormCreate(Sender: TObject);
begin
  RsltStream:=TMemoryStream.Create;
  TmpStream:=TMemoryStream.Create;
end;

为Client的OnDestroy事件添加代码:
procedure TServer.FormDestroy(Sender: TObject);
begin
  RsltStream.Free;
  TmpStream.Free;
end;

为控件Button1的OnClick事件添加代码:
procedure TServer.Button1Click(Sender: TObject);
var ReqCode:array[0..29] of char;ReqCodeStr:string;
begin
  ReqCodeStr:=show+Edit1.Text;
  StrpCopy(ReqCode,ReqCodeStr);
  TmpStream.Clear;
  RsltStream.Clear;
  SUDP.RemoteHost:=Edit2.Text;
  SUDP.SendBuffer(ReqCode,30);
end;

为控件SUDP的OnDataReceived事件添加代码:
procedure TServer.SUDPDataReceived(Sender: TComponent;
  NumberBytes: Integer; FromIP: String);
var ReqCode:array[0..29] of char;ReqCodeStr:string;
begin
  ReqCodeStr:=show+Edit1.text;
  StrpCopy(ReqCode,ReqCodeStr);
  SUDP.ReadStream(TmpStream);
  RsltStream.CopyFrom(TmpStream,NumberBytes);
  if NumberBytes< BufSize then { 数据已读完 }
  begin
RsltStream.Position:=0;
Image1.Picture.Bitmap.LoadFromStream(RsltStream);
TmpStream.Clear;
RsltStream.Clear;
  end
  else
  begin
TmpStream.Clear;
ReqCode:=show;
SUDP.RemoteHost:=Edit2.Text;
SUDP.SendBuffer(ReqCode,30);
  end;
end;

存为“C:\VServer\SvrUnit.pas”和
“C:\VServer\VServer.dpr”,并编译。

---- 四、测试。
---- 1、本地机测试:在本地机同时运行Vserver.exe和VClient.exe,利用程序的默认设置,即可实现截屏。查看“控制面板”-“网络”-“TCP/IP”-“IP地址”,将程序的“客户IP地址”设为该地址 ,同样正常运行。

---- 2、远程测试:选一台受控机,运行VClient.exe;另选一台主控机,运行VServer.exe,将“受控机IP地址”即Edit2的内容设为受控机的IP地址,“截屏”即可。以上简要介绍了远程屏幕抓取的实现方法,至于在主控机上一屏同时监视多个受控机,读者可自行完善。以上程序,在Windows98对等网、Delphi 4.0下调试通过。

在DELPHI中用ADSI来控制IIS,检测、增加、删除虚拟目录

//在DELPHI中用ADSI来控制IIS,检测、增加、删除虚拟目录
//========================================================
//本代码转自网络,是WebService开发时经常要用到的东东,感谢原作者
//本人稍作修改,并将其整理,希望对大家有用
//========================================================

//删除虚拟目录应用程序名

  1. function DeleteVirtualDirApp(strVirtualDir: string): Boolean;   
  2. var  
  3.   WebSite, WebServer, WebRoot, vdir: Variant;   
  4. begin  
  5.   Result := True;   
  6.   try  
  7.     WebSite := CreateOleObject('IISNamespace');   
  8.     WebSite := WebSite.GetObject('IIsWebService''localhost/w3svc');   
  9.     WebServer := WebSite.GetObject('IIsWebServer''1');   
  10.     WebRoot := WebServer.GetObject('IIsWebVirtualDir''Root');   
  11.     vdir := WebRoot.GetObject('IIsWebVirtualDir', strVirtualDir);   
  12.     vdir.AppDelete;   
  13.     vdir.SetInfo;   
  14.   except  
  15.     Result := False;   
  16.   end;   
  17.   
  18. end;[/code]   
  19. //删除虚拟目录[codes=delphi]   
  20. function DeleteVirtualDir(strVirtualDir: string): Boolean;   
  21. var  
  22.   WebSite, WebServer, WebRoot, vdir: Variant;   
  23. begin  
  24.   Result := True;   
  25.   try  
  26.     WebSite := CreateOleObject('IISNamespace');   
  27.     WebSite := WebSite.GetObject('IIsWebService''localhost/w3svc');   
  28.     WebServer := WebSite.GetObject('IIsWebServer''1');   
  29.     WebRoot := WebServer.GetObject('IIsWebVirtualDir''Root');   
  30.     WebRoot.Delete('IIsWebVirtualDir', strVirtualDir);   
  31.   except  
  32.     Result := False;   
  33.   end;   
  34. end;  


{检测是否有虚拟目录}

  1. function CheckVirtualDir(const strVirtualDir: string): Boolean;   
  2. var  
  3.   WebSite, WebServer, WebRoot, vdir: Variant;   
  4. begin  
  5.   Result := True;   
  6.   try  
  7.     WebSite := CreateOleObject('IISNamespace');   
  8.     WebSite := WebSite.GetObject('IIsWebService''localhost/w3svc');   
  9.     WebServer := WebSite.GetObject('IIsWebServer''1');   
  10.     WebRoot := WebServer.GetObject('IIsWebVirtualDir''Root');   
  11.     WebRoot.GetObject('IIsWebVirtualDir', strVirtualDir);   
  12.   except  
  13.     Result := False;   
  14.   end;   
  15. end;  


//建立虚拟目录

  1. function CreateVirtualDir(const strVirtualDir, strDir, strAppName: string): Boolean;   
  2. var  
  3.   WebSite, WebServer, WebRoot, vdir: Variant;   
  4. begin  
  5.   Result := True;   
  6.   try  
  7.     WebSite := CreateOleObject('IISNamespace');   
  8.     WebSite := WebSite.GetObject('IIsWebService''localhost/w3svc');   
  9.     WebServer := WebSite.GetObject('IIsWebServer''1');   
  10.     WebRoot := WebServer.GetObject('IIsWebVirtualDir''Root');   
  11.     vdir := WebRoot.Create('IIsWebVirtualDir', strVirtualDir);   
  12.     vdir.AccessRead := True;   
  13.   
  14.     vdir.AccessScript := True; //执行许可为纯脚本   
  15.     vdir.DefaultDoc := 'index.aspx,index.asp'//默认文档   
  16.     vdir.EnableDirBrowsing := False;   
  17.     vdir.AppFriendlyName := strAppName; //应用程序名   
  18.     vdir.Path := strDir;   
  19.     vdir.AppCreate(True); //如果没有这句的话,虚拟目录就要人为的手工创建应用程序名   
  20.     vdir.SetInfo;   
  21.   except  
  22.     Result := False;   
  23.   end;   
  24. end;  

dephi中用idhttp提交cookie

以前不管是做什么软件,只要是关于网页post提交cookie的,我都是用TcpClient,为什么呢?
因为我一直找不到idhttp提交Cookie的方法,今天终于有了结果。

在Idhttp中,要想修改Cookie的代码,就要用到Request的RawHeaders中的Values值。
这个值怎么用呢?
Values接受一个string的值,该值指定了所访问的变量。
如HTTP头是这样定义的(其中一些):
Accept-Language: zh-cn
Content-Type: application/x-www-form-urlencoded
Accept-Encoding: gzip, deflate
User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1;
Cookie: JSESSIONID=aoOYvjM-IKzh
而Values的值就可以是Cookie,User-Agent,Accept-Encoding……等等。

所以,代码应该是这样:
try
  idhttp1.Request.RawHeaders.Values['Cookie'] := '这里是cookie的值'; //
  memo1.Lines.Add(idhttp1.Request.RawHeaders.Values['Cookie']);
  idhttp1.Post('/webmail/login.jsp',data1,data2);
  memo1.Lines.Add(idhttp1.Request.RawHeaders.Values['Cookie']);
  idhttp1.Request.RawHeaders.Values['Cookie'] := 'asdfasdf';
  memo1.Lines.Add(idhttp1.Request.RawHeaders.Text);
except
  idhttp1.Get(idhttp1.Response.Location, data1);
end;
初一看,这代码是没有什么问题的。但,memo1的第一次ADD并没有任何值,奇怪。
而第三次ADD就被改为了'asdfasdf',正是我们所希望的。
我正是卡在了这里。为什么第一次idhttp1.Request.RawHeaders.Values['Cookie'] := '这里是cookie的值'; 没有结果呢?

搞了很久。我才发现,在第一次传值的时候,RawHeaders跟本没有被初始化。而第三次经过Post以后,RawHeaders被初始化了,所以得到了我们所要的结果。
也就是说,在写漏洞上传程序这些的时候,如果先Post让RawHeaders初始化,那就没什么意义了,因为Post的时候,Cookie就不能被带上了。

正确的代码应该是这样:
try
  idhttp1.Request.SetHeaders; //最重要的初始化。
  idhttp1.Request.RawHeaders.Values['Cookie'] := '这里是cookie的值';
  idhttp1.Post('/webmail/login.jsp',data1,data2);
except
  idhttp1.Get(idhttp1.Response.Location, data1);
end;


这里,最重要的初始化是必需的。
idhttp1.Request.SetHeaders
这个过程如果没有。就会出错。

IStream与TStream之间的相互转换

 

Delphi代码
  1. //IStream与TStream之间的相互转换   
  2. procedure TForm1.Button1Click(Sender: TObject);   
  3. var  
  4.   memoStream,OleStream:TStream;   
  5.   Stream : IStream;   
  6. begin  
  7.   image1.Picture :=nil;   
  8.   image2.Picture :=nil;   
  9.   
  10.   //显示初始照片   
  11.   image1.Picture.LoadFromFile('c:\logo.bmp');   
  12.   memoStream := TmemoryStream.Create;   
  13.   try  
  14.   //将照片保存为TmemoryStream   
  15.     image1.Picture.Bitmap.SaveToStream(memoStream);   
  16.     memoStream.Position :=0;   
  17.   
  18.   //将TmemoryStream转成IStream   
  19.     stream:=TStreamAdapter.Create(memoStream);   
  20.   
  21.   //将IStream转成TOleStream ==TmemoryStream   
  22.     OleStream := TOleStream.Create(Stream);   
  23.     image2.Picture.Bitmap.LoadFromStream(OleStream);   
  24.   finally  
  25.     memoStream.Free;   
  26.     OleStream.Free;   
  27.   end;   
  28. end;   
  29.   
  30.   
  31. ///////////////////////////   
  32.   
  33. uses  
  34.   
  35. ....................AxCtrls,ActiveX;    //必加此二单元