delphi2007 教程

两数组的问题? Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiBase/html/delphi_20061217001324138.html
问题1：找出两数组的不同数和共有数的值和位置，和同值同位置的值存入数组s1……s9  
  如：  
  数组值r1为{   1,   6,23,15,   5,28,   8,11,10,19}  
  数组值r2为{   2,23,   4,15,   5,17,12,11,   3}  
   
  需要找出：  
  数组值r1不同数的值：           s1   {1,6,28,8,10,19}  
  数组值r1不同数的位置：       s2   {0,1,5,6,8,9}  
  数组值r2不同数的值：           s3   {2,4,17,12,3}  
  数组值r2不同数的位置：       s4   {0,2,5,6,8}  
  两数组共有数的值：               s5   {23,15,5,11}  
  两数组共有数r1的位置：       s6   {2,3,4,7}  
  两数组共有数r1的位置：       s7   {1,3,4,7}  
  两数组同值同位置的值：       s8   {15,5,11}  
  两数组同值同位置的位置：   s9   {3,4,7}  
   
  注意：实际应用中是动态数组,而且还很大,需要一个精简的办法！！  
   
   
   
   
  问题2:把数组按数值从小到大排列。同上注意！！！

var  
      R1:   array   of   Integer;  
      R2:   array   of   Integer;  
      SL1:   TStringList;  
      SL2:   TStringList;  
      Idx:   Integer;  
      Index:   Integer;  
      S1:   array   of   Integer;  
      S2:   array   of   Integer;  
      S3:   array   of   Integer;  
      S4:   array   of   Integer;  
      S5:   array   of   Integer;  
      S6:   array   of   Integer;  
      S7:   array   of   Integer;  
      S8:   array   of   Integer;  
      S9:   array   of   Integer;  
  begin  
      Setlength(R1,   10);  
      SetLength(R2,   9);  
      R1[0]   :=   1;  
      R1[1]   :=   6;  
      R1[2]   :=   23;  
      R1[3]   :=   15;  
      R1[4]   :=   5;  
      R1[5]   :=   28;  
      R1[6]   :=   8;  
      R1[7]   :=   11;  
      R1[8]   :=   10;  
      R1[9]   :=   19;  
   
      R2[0]   :=   2;  
      R2[1]   :=   23;  
      R2[2]   :=   4;  
      R2[3]   :=   15;  
      R2[4]   :=   5;  
      R2[5]   :=   17;  
      R2[6]   :=   12;  
      R2[7]   :=   11;  
      R2[8]   :=   3;  
   
      SL1   :=   TStringList.Create;  
      SL2   :=   TStringList.Create;  
   
      //'%.8d'的目的有2个，  
      //其一是排序，   其二是满足大数据  
   
      for   Idx   :=   Low(R1)   to   High(R1)   do  
          SL1.Add(Format('%.8d',   [R1[Idx]]));  
   
      for   Idx   :=   Low(R2)   to   High(R2)   do  
          SL2.Add(Format('%.8d',   [R2[Idx]]));  
   
      //为了显示方便，我用了ListBox.  
      //在你的实际程序中你可以用TStringList来代替.  
   
      ListBox1.Sorted   :=   True;  
      ListBox2.Sorted   :=   True;  
      ListBox3.Sorted   :=   True;  
      ListBox4.Sorted   :=   True;  
      ListBox5.Sorted   :=   True;  
      ListBox6.Sorted   :=   True;  
      ListBox7.Sorted   :=   True;  
      ListBox8.Sorted   :=   True;  
      ListBox9.Sorted   :=   True;  
   
      for   Idx   :=   0   to   Pred(SL1.Count)   do      
      begin  
          Index   :=   SL2.IndexOf(SL1[Idx]);  
          if   Index   <   0   then  
          begin  
              ListBox1.Items.Add(SL1[Idx]);  
              ListBox2.Items.Add(Format('%.8d',   [Idx]));  
          end   else  
          begin  
              ListBox5.Items.Add(SL1[Idx]);  
              ListBox6.Items.Add(Format('%.8d',   [Idx]));  
              ListBox7.Items.Add(Format('%.8d',   [Index]));  
              if   Idx   =   Index   then  
              begin  
                  ListBox8.Items.Add(SL1[Idx]);  
                  ListBox9.Items.Add(Format('%.8d',   [Idx]));  
              end;  
          end;  
      end;  
   
      for   Idx   :=   0   to   Pred(SL2.Count)   do  
      begin  
          if   SL1.IndexOf(SL2[Idx])   <   0   then  
          begin  
              ListBox3.Items.Add(SL2[Idx]);  
              ListBox4.Items.Add(Format('%.8d',   [Idx]));  
          end;  
      end;  
   
      //剩下的工作就是把Listbox   --->   s数组,  
      //我只写一个，其余的照葫芦画瓢}  
       
      SetLength(S1,   ListBox1.Items.Count);  
      for   Idx   :=   0   to   Pred(ListBox1.Items.Count)   do  
          S1[Idx]   :=   StrToInt(ListBox1.Items[Idx]);  
   
      //上面算法的前提  
      //1、是每个数组自身没有重复数  
      //2.   R1的长度大于等于R2的长度  
   
    //如要满足任何条件，算法基本没有大的变化，   只是多了一个遍历  
   
   
  end;

请问：软件运行前的设置界面显示'第一次运行软件，正在设置...'等信息的东东叫什么？如何做出这种东东呢？ Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiBase/html/delphi_20061216184137139.html
就是说软件工作前要有一段初始化的工作，将这个信息提供给使用者，如何用最简单的方法做出这种功能呢？最好能给一点代码参考，万分感谢回答的朋友！

读写INI文件就可以啦

读写INI文件,注册表，二进制文件等   ，都是可以的

做个form是最简单的

如何计算某时间段内有几个星期几? Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiBase/html/delphi_20061216151111140.html
已知日期A是星期二、四、日中的一天。求A到B这段日期内共有几个星期二、四、日？

{   函数参数说明：A--The   Old   Date       B--The   Nearest   Date     Dw--说明要统计的是周几}  
  {   Dw   ==   1     统计周日数量  
      Dw   ==   2     统计周一数量  
      Dw   ==   3     统计周二数量  
      Dw   ==   4     统计周三数量  
      Dw   ==   5     统计周四数量  
      Dw   ==   6     统计周五数量  
      Dw   ==   7     统计周六数量   }  
   
  function   MyFuc(   A,B   :TDateTime;   Dw   :integer):integer;  
  var  
        X,Y,Z:integer;  
  begin  
        X   :=   DayOfWeek(   A   );  
        {     if   not(   X   in   [0,2,4])   then       //如果你需要限制日期   A   只能  
                    begin                                           //是   周二、四、日  
                    Result   :=   -1   ;                         //那么你可以把我注掉的  
                    exit;                                           //这个判断语句启用  
                    end;         }                                   //，于是，非周二四日，则返回-1。  
        Z   :=   Round(   B   -   A   )   mod   7   ;  
        if   Z+X   <=   7   then  
              if   (Dw   >=   X)   and   (Dw   <=   Z+X)   then   Y   :=   1   else   Y   :=   0  
              else  
              if   Z+X-7   >=   Dw   then   Y   :=   1  
                    else   if   (Dw   <=   Z+X)   and   (Dw   >=   X)   then   Y   :=   1   else   Y   :=   0;  
   
        Result   :=   Round(   B   -   A   )   div   7       +   Y   ;  
  end;  
   
  procedure   TForm1.Button1Click(Sender:   TObject);   //调用函数举例  
  var  
        A,B:TDateTime;  
  begin  
        A   :=   VarToDatetime('2006-11-18');  
        B   :=   VarToDatetime('2006-12-16');  
        ShowMessage(   inttostr(MyFuc(a,b,1))   +   '个星期日'   +   #13  
                              +   inttostr(MyFuc(a,b,2))   +   '个星期一'   +   #13  
                              +   inttostr(MyFuc(a,b,3))   +   '个星期二'   +   #13  
                              +   inttostr(MyFuc(a,b,4))   +   '个星期三'   +   #13  
                              +   inttostr(MyFuc(a,b,5))   +   '个星期四'   +   #13  
                              +   inttostr(MyFuc(a,b,6))   +   '个星期五'   +   #13  
                              +   inttostr(MyFuc(a,b,7))   +   '个星期六');  
  end;

注意，注掉的那个判断部分，有个小错，即：你把那个集合[0,2,4]改为[1,3,5]即可！！  
   
  测试结果：(2006-11-18～2006-12-16)  
   
  4个星期日  
  4个星期一  
  4个星期二  
  4个星期三  
  4个星期四  
  4个星期五  
  5个星期六  
 

先谢谢lihuasoft(学习低调做人)你的回复,我所说的"求A到B这段日期内共有几个星期二、四、日？"是指总数,不用分开计.下面是我用的方法，请指教。  
  procedure   TForm1.Button1Click(Sender:   TObject);  
  var   i,j,k:integer;  
  begin  
      i:=daysbetween(vartodatetime(edit1.Text),vartodatetime(edit2.Text));  
      j:=dayoftheweek(vartodatetime(edit1.Text));  
      k:=i   div   7;  
      i:=i   mod   7;  
      if   j=2   then   i:=(i+1)div   3  
      else   if   j=4   then   i:=(i-1)div   2  
      else   if   j=7   then   begin  
          if   i>4   then   i:=4;  
          i:=i   div   2;  
      end;  
      j:=k*3+i;  
      edit3.Text:=   inttostr(j);  
  end;

偶能斗胆回一下楼主的贴子，已经感激不尽了，因此楼主不必感谢。而“指教”，偶更不敢当。  
   
  测试了一下楼主的代码：2006-12-12（周二)～2006-12-31     结果是：8  
   
  而如果用我的函数:    
  var  
        A,B:TDateTime;  
  begin  
        A   :=   VarToDatetime(Edit1.Text);   //Edit1.text:='2006-12-12'  
        B   :=   VarToDatetime(Edit2.Text);   //Edit2.text:='2006-12-31'  
        ShowMessage(IntToStr(   MyFuc(a,b,1)+MyFuc(a,b,3)+MyFuc(a,b,5)));  
  end;  
  测试结果是：   9  
   
  看到楼主的题目时，我就想：我应该尽可能地写一个通用的函数，这个函数要不仅仅只能统计“周二、周四、周日”，而是应该周几都能统计。于是我就那样写了。  
  至于您说的“总和”，无非就用算术上最普通的加法即可解决：MyFuc(a,b,1)+MyFuc(a,b,3)+MyFuc(a,b,5)  
   
  我说的不当之处，望楼主原谅。

噢，对了，我的代码是不计A这天的，因这天已知是星期二、四、日中的了。即B-A后的时间段。

这几天惨遭Delphi类型转换折磨，请问怎么把double转成int类型 Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiBase/html/delphi_20061216093950141.html
好不容易找了个FloatToDecimal函数，摆置了半天也不知道怎么个用法，真郁闷。  
   
  高手赶快指点指点，我快被delphi折磨疯了!!

Round   四舍五入  
  Trunc   截尾取整

急！delphi中variant能否和object类型转换。实例：在使用getpropvalue(range,'属性')时提示类型有错，如何解决？！！ Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiBase/html/delphi_20061215234307142.html
小弟在编写程序过程中，想取得某一属性值，使用getpropvalue函数，出现错误，如何解决？  
  在程序中想得到EXCEL单元格的值，如下定义：  
  vapp,vrange:variant;  
  strcell:variant;  
  vapp:=createoleobject('excel.application');  
  vrange:=vapp.workbooks[1].sheets[1].range;  
  strcell:=getpropvalue(vrange,'value');   //我必须用到一变量属性，而不能固定   写为vrange.value  
  总是报错，说类型不匹配，我知道应将varange设为Tobject类型，而这样设后vrange:=vapp.workbooks[1].sheets[1].range;此句又编译不通过，请问如何解决？  
 

急，数组1排序后->数组2，求算法！3Q Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiBase/html/delphi_20061215205531143.html
数组1排序，同时将数组1排序前的序号值按排序后的顺序存入数组2，求一简单算法（代码少优先，速度其次）  
  例：  
   
  A[0]=4  
  A[1]=5  
  A[2]=3   ...  
   
  A[1]最大，A[0]第二，A[2]第三  
  则取A的原序号->B  
   
  B[0]=1  
  B[1]=0  
  B[2]=2...  
   
  3q~  
 

在线等ing~

没看动啥意思  
   
  如果只是排序，DELPHI自带的关于线程的DEMO中有排序算法。

.......就是  
  A[0]=4  
  A[1]=5  
  A[2]=3   ...  
  可见：  
  A[1]最大，其序号A[i]的i=1  
  A[0]第二，其序号A[i]的i=0  
  A[2]第三,   其序号A[i]的i=2  
  所以：  
  要求获得:  
  B[0]=1  
  B[1]=0  
  B[2]=2...

unit   Unit1;  
   
  interface  
   
  uses  
      Windows,   Messages,   SysUtils,   Variants,   Classes,   Graphics,   Controls,   Forms,  
      Dialogs,   StdCtrls;  
   
  type  
      Ttest=record  
          data   :   Integer;  
          index   :   Integer;  
      end;  
      TForm1   =   class(TForm)  
          Memo1:   TMemo;  
          Button1:   TButton;  
          Memo2:   TMemo;  
          procedure   Button1Click(Sender:   TObject);  
      private  
          {   Private   declarations   }  
      public  
          {   Public   declarations   }  
      end;  
   
  var  
      Form1:   TForm1;  
   
  implementation  
   
  {$R   *.dfm}  
   
  procedure   TForm1.Button1Click(Sender:   TObject);  
  var  
      fArray   :   array[0..5]   of   Ttest;  
      i,j   :   integer;  
      t   :   Ttest   ;  
  begin  
        Randomize;  
        //初始化一个数组  
        for   i:=   0   to   5   do  
        begin  
            fArray[i].data   :=   Random(100);  
            fArray[i].index   :=   i;  
            Memo1.Lines.Add(Format('数据:%d;序号:%d',[fArray[i].data,fArray[i].index]));  
        end;  
   
        //排序  
            for   I   :=   High(fArray)   downto   Low(fArray)   do  
          for   J   :=   Low(fArray)   to   High(fArray)   -   1   do  
              if   fArray[J].data   >   fArray[J   +   1].data   then  
              begin  
                  T   :=   fArray[J];  
                  fArray[J]   :=   fArray[J   +   1];  
                  fArray[J   +   1]   :=   T;  
              end;  
   
          //显示结果  
        for   i:=   0   to   5   do  
            Memo2.Lines.Add(Format('数据:%d;序号:%d',[fArray[i].data,fArray[i].index]))  
   
  end;  
   
  end.  
 

靠，反了，我是按照从小到大排序的，你调整一下就可以了。

就是要这个效果！！我郁闷了1天啊！！！！万万分感谢！！！！！！！;  
  3Q3Q3Q3Q;

小弟请教一个问题,关于fastreport Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiBase/html/delphi_20061215203149144.html
我用fastreport制作了一个报表,我想在程序运行的同时自动更换报表标题.最好有例子.

up

在执行打印操作的按钮(或菜单)的代码中写：FrReport1.FindObject('标题的文本框名称').Memo.Text:='报表的标题';  
   
   
   
  ----------------------------------  
  http://kmok.cn/

老是报错.

请问vc里面的 0x0L 转化为delphi该如何写啊 Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiBase/html/delphi_20061215185430145.html
请问vc里面的   0x0L   转化为delphi该如何写啊

$00

longint(0)  
 

请问你看完这个有何感想？关于Delphi中的类型转换?? Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiBase/html/delphi_20061215172228146.html
IntToStr(abs(StrToInt(BoolToStr(iADOQuery.FieldValues['ifaccept']))))  
   
  因为ifaccept字段是bit类型的，数据库里面的值如果是1的话，现在我要使用转换的方法取得一个1,而不是用if来进行判断，最后竟然写成上面的一堆代码！！  
   
  请问有更简单的办法吗？？   总体感觉Delphi的类型转换审查太严，不想C++   Builder中的用着爽!!  
   
  更奇怪的是BoolToStr函数如果里面的是1的话，返回的是-1,我真搞不明白,borland的工程师为什么要这样,直接给个1不更好吗？  
   
  各位有何看法，讲讲。

iADOQuery.FieldValues('ifaccept').AsString  
   
  or  
   
  IntToStr(Ord(iADOQuery.FieldValues('ifaccept').AsBoolean))  
   
  只能说你的代码很有想像力！

 
      SetLength(TrueBoolStrs,   1);  
      SetLength(FalseBoolStrs,   1);  
      TrueBoolStrs[0]   :=   '1';  
      FalseBoolStrs[0]   :=   '0';  
   
      BoolToStr(iADOQuery.FieldValues('ifaccept').AsBoolean,   True);  
 

query怎么停止啊！在线等！ Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiBase/html/delphi_20061215162623147.html
我做了一个循环语句，显示数据库某一个表里面的纪录，一条一条显示。  
  用NEXT向下检索，用SLEEP让线程休息，单如果我想让QUERY停下来到当前行，怎么停呢。我是定义了一个全局变量，当变量等于某一个值时就停止。  
  QUERY应该如何写停呢？？？停在当前阿！！！

停就让它指到最后一条不就得了?反正你要的数据也得到了不是吗?

exit;语句不就跳出来了啦...

如何 获得 自身程序 的 版本号 ???? 急!!!!!!!!!!!! Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiBase/html/delphi_20061215121930148.html
如何   获得   自身程序   的   版本号   ????   急!!!!!!!!!!!!  
   
  请给出详细的代码!

function   GetFileVersion(FileName   :   String):   String;  
  var  
      InfoSize,   Wnd:   DWORD;  
      VerBuf:   Pointer;  
      FI:   PVSFixedFileInfo;  
      VerSize:   DWORD;  
  begin  
      Result   :=   '';  
      InfoSize   :=   GetFileVersionInfoSize(PChar(FileName),   Wnd);  
      if   InfoSize   <>   0   then  
      begin  
          GetMem(VerBuf,   InfoSize);  
          try  
              if   GetFileVersionInfo(PChar(FileName),   Wnd,   InfoSize,   VerBuf)   then  
                  if   VerQueryValue(VerBuf,   '\',   Pointer(FI),   VerSize)   then  
                  begin  
                      Result   :=   InttoStr(FI.dwFileVersionMS   div   $FFFF);  
                      Result   :=   Result+'.'+InttoStr(FI.dwFileVersionMS   mod   $10000);  
                      Result   :=   Result+'.'+InttoStr(FI.dwFileVersionLS   div   $FFFF);  
                      Result   :=   Result+'.'+InttoStr(FI.dwFileVersionLS   mod   $10000);  
                  end;  
          finally  
              FreeMem(VerBuf);  
          end;  
      end;  
  end;  
   
  procedure   TAboutForm.FormCreate(Sender:   TObject);  
  var  
      strTemp,FileName:   String;  
  begin  
      FileName   :=   Application.EXEName+chr(0);  
      strTemp   :=   GetFileVersion(FileName);  
      if   strTemp<>''   then  
            Label1.Caption   :=   '（V'+strTemp+'）';  
  end;  
   
 

来晚了。接分。

ding

用Raize组件的TRzVersionInfoStatus

看资料得知tbitmap,image,tjpegimage等都不是线程安全的，那么如何后台开一个线程打开N个图片并且显示在某个scrollbox中呢？ Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiBase/html/delphi_20061215012308149.html
经过多次试验，总是莫名奇妙出错，我想原因可能就是这个线程安全吧，那么即然这么多VCL都是线程不安全的，那么还能不能实现做一个可以后台打开图片的浏览器呢？

大侠们帮个忙吧，给一个思路好啊。。

是线程安全的吧.  
  Image.Canvas.Lock;

这个好像也不行，只要是后台打开图片，不管用什么方法，等你去浏览的时候总是出模名奇妙的问题，我这里的故障现像是总会少一些图片。即然可视控件都是非线程安全的，那么用DELPHI就不能实现在后台打开图片的功能了吗？

请教：如何设置Lable中的字符间距和行距！前提是不改变字体字号. Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiBase/html/delphi_20061215001442150.html
请教：如何设置Lable中的字符间距和行距！前提是不改变字体字号.

加空格^_^  
   
  没有好的办法，你用个TImage自己画吧。  
  哪怕自己写个组件也不麻烦。

加空格和#13

加密锁写入问题 Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiAPI/html/delphi_20061205113039121.html
正在写加密锁的程序,但是sdk中DOGWRITE()函数每次写一个WORD进去,我想让它每次写一个BYTE进去.能提点思路吗?

读出Word，修改Byte，再写回   WORD

我声明了一个结构体    
  type    
        TMyWord   =   record  
              HByte:Byte;  
              LByte:Byte;  
        end;  
  程序里用的时候：  
  var  
      data:TMyWord;  
      data1:WORD;  
      HiByte,LoByte:Byte;  
  begin  
      HiByte   :=   ord('a');  
      LoByte   :=   ord('b');  
      data.HByte   :=   HiByte;  
      data.LByte   :=   LoByte;  
      data1   :=   WORD(data);      
  end;  
  这样倒是满足我的需求了，但是我不知道这样做是不是有危险那？

只要你做了,就有分了,谢谢大家帮忙了 Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiAPI/html/delphi_20061204230234122.html
CSDN的兄弟大哥帮帮忙  
   
  江西省十大文明执法人员开始抽票了,为了我们景德镇瓷都人的荣誉,请投我们家乡人一票,他是9号,环保局的余志华,  
   
  投票地址:  
   
  http://www.jxgdw.com/jxgd/jxtv/huodong/wmzf/wmzfindex.php  
   
  (选足十人才能投票)  
   
  投票有分,一票一分,(一IP只能投一次,如需多投须刷新IP)  
   
 

sf~~~

zZz~~~

接分?~~~~

从不在CSDN上骂人,今天开例了!  
  这狗日的就是当那些官的狗腿子!  
  每个CSDN人有点骨气就不要为了这虚拟的分值被这种鸟人收买!

世道如此   楼上的有什么好说的   竟然发到技术帖子来了   我也回答一下好了~~    
   
  自己写个投票程序不就可以了  
  1个IP投一次   你就用代理服务器解决      
  要选10个人的话你让程序其中有一个选你们老总   其他的9个随即选不就可以了吗      
       
   
  3个月前我们技术总监也参加类似的评选     当时我就写了一个    
 

我投了，接分

根本不了解，投什么鸟票？

^_^  
   
   
  友情UP下！

PPLIVe是如何通过URL来启动程序的？ Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiAPI/html/delphi_20061204214449123.html
synacast://09jN1+TK3K3nm63LoKXPnNeS0aWenKOZ1aLRltiX1qKZnNeVoaKkoq6V1KXN5pzI2dSpnamVo5bayuPKrSoPPWoyZRMUm6mWnaKknhkOnT1kKUwgFTEWo6iVpaKnuOTKz8DVztnKmKKfmqOXqKWVo6eVo6OS1eXMraKcm6SWoaSamqSWpqmmoaaVoKqkmaaVltvbpuvJ4OSmmKWdntedzaTT1eSmoaaVoKvhzebZqp+b0qTModSa19vZqqicmaag5dTc3bCUn9ua0KfJnt7R3bCdoKCcpOvJ4OSmmKWbntedzaTT1eSmoaaVoKvhzebZqp+bmaTModSa19vZqqicmaag5NPc3bCUn6ma0KfJnt7R3bCdoKvgzObZqp+boKTModSa19vZqqicpOrI4OSmmKWYntedzaTT1eSmoaY=/  
   
  类似这样的URL，PPLIVE就从IE判断？   然后启动PPLIVE？  
   
  好象BT也有这样的情况，这种技术如何实现的？

bho可以。。  
    似乎不是监控ie其他的不清除了  
  其他的注册方式？

帮顶一下

没有BHO那么复杂，这是利用URL   Protocol实现的，还是比较简单的  
   
  相关的技术文章参考：  
  1.   Registering   an   Application   to   a   URL   Protocol   ---FROM   MSDN  
  http://msdn.microsoft.com/library/default.asp?url=/workshop/networking/pluggable/overview/appendix_a.asp  
   
  using   URL   protocol   handlers   in   windows  
  http://www.realvnc.com/pipermail/vnc-list/2003-October/041408.html  
   
  查看注册表可见   pplive注册的Synacast协议的信息  
  [HKEY_CLASSES_ROOT\Synacast]  
  "@"="URL:synacast   Protocol"  
  "Version"="1.3.20"  
  @="URL:synacast   Protocol"  
  "URL   Protocol"=""  
   
  [HKEY_CLASSES_ROOT\Synacast\DefaultIcon]  
  @="C:\\Program   Files\\PPLive\\PPLive.exe"  
   
  [HKEY_CLASSES_ROOT\Synacast\Shell]  
   
  [HKEY_CLASSES_ROOT\Synacast\Shell\Open]  
   
  [HKEY_CLASSES_ROOT\Synacast\Shell\Open\Command]  
  @="C:\\Program   Files\\PPLive\\PPLive.exe   \"%1\""

mark   ...

安了，我写了一个demo,放在我的blog中  
   
  http://borland.mblogger.cn/aigooo/posts/33394.aspx  
   
  http://blog.csdn.net/do2008/archive/2006/12/07/1434014.aspx  
 

Study

Zlib单元不能编译了 Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiAPI/html/delphi_20061204173958124.html
[Error]       ZLib.pas(222):       Unsatisfied       forward       or       external       declaration:       'inflate_trees_free'        
      [Error]       ZLib.pas(562):       Unsatisfied       forward       or       external       declaration:       '@zcalloc'        
      [Error]       ZLib.pas(562):       Unsatisfied       forward       or       external       declaration:       '@zcfree'        
      [Error]       ZLib.pas(562):       Unsatisfied       forward       or       external       declaration:       '_z_errmsg'        
      [Fatal       Error]       UClnMain.pas(8):       Could       not       compile       used       unit       'ZLib.pas'  
         
  到底怎么回事？急死了

你是怎么编译的？你的zlib的位置，及是否加入了project等具体的情况是什么样的？

我在interface   里uses   zlib,  
  在环境路径里加入了Zlib的路径，  
  在project里也加入了搜索路径  
  ======  
  前2次还编译通过了，后来就不能编译了,不知道怎么了？？？？？  
  9999999999

1.检查一下zlib.pas的修改日期，是否无意中修改了这个文件;(这个可能性，比较小)  
  2.检查一下，use   zlib的单元，看相关的代码有无变动(如果有cvs,svn等版本控制工具，就容易多了)  
   
  3.删除project的编译的文件，如*.dcu等等(如GExperts的Clean   Directories的功能，是最好的)  
   
  然后再重新Build   Project试试；

up

对，zlib.pas被修改了，但是我按照以上方法还没编译通过，  
   
  不知道什么原因，我在家里用zlib.pas新建项目，一切ok，  
  把zlib.pas带到公司，放到source\rtl\comma下，  
  覆盖原zlib文件，新建了一个工程  
  在interface   use   zlib  
  编译时都会在  
  procedure   inflate_trees_free;   external;  
  这行过不去，  
  并且报如题目所写的错误。

如果,是这情况的话，可能需要检查一下，你在公司的开发环境下，除了zlib.pas还有哪些文件修改过了。  
   
  比如zlib.pas   就分别use了这3个单元，  
  SysUtils,   Classes;  
  ZLibConst;  
   
  最好是用windows的查找文件功能，查找一下，近期都修改了哪些vcl的文件  
   
  有时原因可能是很简单的，一个定义不对，或者是少了个分号；引起的

获得internet 时间的问题? Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiAPI/html/delphi_20061204151729125.html
在网上下载的源码都提示找不到控件.  
   
  能给个最简单的吗？  
  还有说明一下控件在要哪儿添加.和使用方法.

给分自己行吗？？？  
  结帖了。

给分自己行吗？？？  
  ------------  
  不可以  
  JF

//直接使用   TClientSocket  
  unit   TimeDllU;  
   
  interface  
   
  uses  
      Windows,   Messages,   SysUtils,   Classes,   Graphics,   Controls,   Forms,   Dialogs,  
      ScktComp;  
   
  type  
      TDTForm   =   class(TForm)  
          DTSock:   TClientSocket;  
          procedure   DTSockRead(Sender:   TObject;   Socket:   TCustomWinSocket);  
      private  
          {   Private   declarations   }  
      public  
          {   Public   declarations   }  
      end;  
   
  const  
      TimerServer:   string='203.129.68.14';//香港时间服务器  
   
  var  
      DTForm:   TDTForm=nil;  
      DT:   TDateTime=-1;  
      DTReady:   Boolean=False;  
   
      procedure   TimeDllInit();   stdcall  
      function   TimeDllGetTime(doadj:   Boolean):   TDateTime;   stdcall  
      procedure   TimeDllFinish();   stdcall  
   
  implementation  
   
  {$R   *.DFM}  
   
  procedure   TimeDllInit();  
  begin  
      DTForm   :=   TDTForm.Create(Application);  
  end;  
   
  procedure   TimeDllFinish();  
  begin  
      DTForm.Free();  
  end;  
   
  var  
      pTimeZoneInformation:   TTimeZoneInformation;  
  function   TimeDllGetTime(doadj:   Boolean):   TDateTime;  
  var  
      systim:   SYSTEMTIME;  
      hToken:   THANDLE;  
      tkp:   TOKEN_PRIVILEGES;  
      tmp:   DWORD;  
      preTick:   DWORD;  
  begin  
      DT   :=   -1;  
      DTReady   :=   False;  
      try  
          DTForm.DTSock.Host   :=   TimerServer;  
          DTForm.DTSock.Open();  
          preTick   :=   GetTickCount();  
          While   GetTickCount()   -   preTick   <   5000   do  
          begin  
              Sleep(10);  
              Application.ProcessMessages();  
              if   DTReady   then  
                  Break;  
          end;  
      except  
      else  
          ;  
      end;  
      if   DTReady   then  
      begin  
          GetTimeZoneInformation(pTimeZoneInformation);  
          DT   :=   DT   -   pTimeZoneInformation.Bias/(24*60);   //(国际标准时间转换到本地时间)  
          if   doadj   then  
              if   DT   >   38880   then  
              begin  
                  DecodeDate(DT,   systim.wYear,   systim.wMonth,   systim.wDay);  
                  DecodeTime(DT,   systim.wHour,   systim.wMinute,   systim.wSecond,   systim.wMilliSeconds);  
                  if   OpenProcessToken(GetCurrentProcess(),   TOKEN_ADJUST_PRIVILEGES   or   TOKEN_QUERY,   hToken)   then  
                  begin  
                      LookupPrivilegeValue(nil,   'SeSystemTimePrivilege',   tkp.Privileges[0].Luid);  
                      tkp.PrivilegeCount   :=   1;   //   one   privilege   to   set  
                      tkp.Privileges[0].Attributes   :=   SE_PRIVILEGE_ENABLED;  
                      tmp   :=   0;  
                      AdjustTokenPrivileges(hToken,   FALSE,   tkp,   0,   nil,   tmp);  
                  end;  
                  SetLocalTime(systim);  
              end;  
      end;  
      Result   :=   DT;  
  end;  
   
  function   MouthStr2Int(ms:   string):   Word;  
  const  
      MouthStrs:   array   [1..12]   of   string   =  
      (  
          'JAN',  
          'FEB',  
          'MAR',  
          'APR',  
          'MAY',  
          'JUN',  
          'JUL',  
          'AUG',  
          'SEP',  
          'OCT',  
          'NOV',  
          'DEC'  
      );  
  var  
      i:   integer;  
  begin  
      ms   :=   UpperCase(ms);  
      for   i   :=   1   to   12   do  
      begin  
          if   ms   =   MouthStrs[i]   then  
          begin  
              Result   :=   i;  
              Exit;  
          end;  
      end;  
      Result   :=   0;  
  end;  
   
  procedure   TDTForm.DTSockRead(Sender:   TObject;   Socket:   TCustomWinSocket);  
  var  
      sTime   :   string;  
      systim:   SYSTEMTIME;  
      i:   integer;  
      ti:   TDateTime;  
  begin  
      sTime   :=   Socket.ReceiveText;  
      if   Length(sTime)   <   32   then  
      begin  
          i   :=   Pos('   ',   sTime);  
          if   i   =   0   then  
              Exit;  
          systim.wDay   :=   StrToInt(Copy(sTime,   1,   i-1));  
          Delete(sTime,   1,   i);  
          i   :=   Pos('   ',   sTime);  
          if   i   =   0   then  
              Exit;  
          systim.wMonth   :=   MouthStr2Int(Copy(sTime,   1,   i-1));  
          Delete(sTime,   1,   i);  
          i   :=   Pos('   ',   sTime);  
          if   i   =   0   then  
              Exit;  
          systim.wYear   :=   StrToInt(Copy(sTime,   1,   i-1));  
          Delete(sTime,   1,   i);  
   
          i   :=   Pos('   ',   sTime);  
          if   i   =   0   then  
              Exit;  
          ti   :=   StrToTime(Copy(sTime,   1,   i-1));  
          Delete(sTime,   1,   i);  
   
          if   UpperCase(Copy(sTime,   1,   3))   =   'HKT'   then  
          begin  
              DT   :=   EncodeDate(systim.wYear,   systim.wMonth,   systim.wDay);  
              DT   :=   DT   +   ti;  
              DT   :=   DT   -   (8/24);   //   HK   Time   to   UTC   (香港时间转换到国际标准时间)  
              DTReady   :=   True;  
          end;  
      end;  
  end;  
   
  end.  
 

//   改了下，用全角空格对齐  
  unit   TimeDllU;  
   
  interface  
   
  uses  
  　Windows,   Messages,   SysUtils,   Classes,   Graphics,   Controls,   Forms,   Dialogs,  
  　ScktComp;  
   
  type  
  　TDTForm   =   class(TForm)  
  　　DTSock:   TClientSocket;  
  　　procedure   DTSockRead(Sender:   TObject;   Socket:   TCustomWinSocket);  
  　private  
  　　{   Private   declarations   }  
  　public  
  　　{   Public   declarations   }  
  　end;  
   
  const  
  　TimerServer:   string='203.129.68.14';//香港时间服务器  
   
  var  
  　DTForm:   TDTForm=nil;  
  　DT:   TDateTime=-1;  
  　DTReady:   Boolean=False;  
   
  　procedure   TimeDllInit();   stdcall  
  　function   TimeDllGetTime(doadj:   Boolean):   TDateTime;   stdcall  
  　procedure   TimeDllFinish();   stdcall  
   
  implementation  
   
  {$R   *.DFM}  
   
  procedure   TimeDllInit();  
  begin  
  　DTForm   :=   TDTForm.Create(Application);  
  end;  
   
  procedure   TimeDllFinish();  
  begin  
  　DTForm.Free();  
  end;  
   
  var  
  　pTimeZoneInformation:   TTimeZoneInformation;  
  function   TimeDllGetTime(doadj:   Boolean):   TDateTime;  
  var  
  　systim:   SYSTEMTIME;  
  　hToken:   THANDLE;  
  　tkp:   TOKEN_PRIVILEGES;  
  　tmp:   DWORD;  
  　preTick:   DWORD;  
  begin  
  　DT   :=   -1;  
  　DTReady   :=   False;  
  　try  
  　　DTForm.DTSock.Host   :=   TimerServer;  
  　　DTForm.DTSock.Open();  
  　　preTick   :=   GetTickCount();  
  　　While   GetTickCount()   -   preTick   <   5000   do  
  　　begin  
  　　　Sleep(10);  
  　　　Application.ProcessMessages();  
  　　　if   DTReady   then  
  　　　　Break;  
  　　end;  
  　except  
  　else  
  　　;  
  　end;  
  　if   DTReady   then  
  　begin  
  　　GetTimeZoneInformation(pTimeZoneInformation);  
  　　DT   :=   DT   -   pTimeZoneInformation.Bias/(24*60);   //(国际标准时间转换到本地时间)  
  　　if   doadj   then  
  　　　if   DT   >   38880   then  
  　　　begin  
  　　　　DecodeDate(DT,   systim.wYear,   systim.wMonth,   systim.wDay);  
  　　　　DecodeTime(DT,   systim.wHour,   systim.wMinute,   systim.wSecond,   systim.wMilliSeconds);  
  　　　　if   OpenProcessToken(GetCurrentProcess(),   TOKEN_ADJUST_PRIVILEGES   or   TOKEN_QUERY,   hToken)   then  
  　　　　begin  
  　　　　　LookupPrivilegeValue(nil,   'SeSystemTimePrivilege',   tkp.Privileges[0].Luid);  
  　　　　　tkp.PrivilegeCount   :=   1;   //   one   privilege   to   set  
  　　　　　tkp.Privileges[0].Attributes   :=   SE_PRIVILEGE_ENABLED;  
  　　　　　tmp   :=   0;  
  　　　　　AdjustTokenPrivileges(hToken,   FALSE,   tkp,   0,   nil,   tmp);  
  　　　　end;  
  　　　　SetLocalTime(systim);  
  　　　end;  
  　end;  
  　Result   :=   DT;  
  end;  
   
  function   MouthStr2Int(ms:   string):   Word;  
  const  
  　MouthStrs:   array   [1..12]   of   string   =  
  　(  
  　　'JAN',  
  　　'FEB',  
  　　'MAR',  
  　　'APR',  
  　　'MAY',  
  　　'JUN',  
  　　'JUL',  
  　　'AUG',  
  　　'SEP',  
  　　'OCT',  
  　　'NOV',  
  　　'DEC'  
  　);  
  var  
  　i:   integer;  
  begin  
  　ms   :=   UpperCase(ms);  
  　for   i   :=   1   to   12   do  
  　begin  
  　　if   ms   =   MouthStrs[i]   then  
  　　begin  
  　　　Result   :=   i;  
  　　　Exit;  
  　　end;  
  　end;  
  　Result   :=   0;  
  end;  
   
  procedure   TDTForm.DTSockRead(Sender:   TObject;   Socket:   TCustomWinSocket);  
  var  
  　sTime   :   string;  
  　systim:   SYSTEMTIME;  
  　i:   integer;  
  　ti:   TDateTime;  
  begin  
  　sTime   :=   Socket.ReceiveText;  
  　if   Length(sTime)   <   32   then  
  　begin  
  　　i   :=   Pos('   ',   sTime);  
  　　if   i   =   0   then  
  　　　Exit;  
  　　systim.wDay   :=   StrToInt(Copy(sTime,   1,   i-1));  
  　　Delete(sTime,   1,   i);  
  　　i   :=   Pos('   ',   sTime);  
  　　if   i   =   0   then  
  　　　Exit;  
  　　systim.wMonth   :=   MouthStr2Int(Copy(sTime,   1,   i-1));  
  　　Delete(sTime,   1,   i);  
  　　i   :=   Pos('   ',   sTime);  
  　　if   i   =   0   then  
  　　　Exit;  
  　　systim.wYear   :=   StrToInt(Copy(sTime,   1,   i-1));  
  　　Delete(sTime,   1,   i);  
   
  　　i   :=   Pos('   ',   sTime);  
  　　if   i   =   0   then  
  　　　Exit;  
  　　ti   :=   StrToTime(Copy(sTime,   1,   i-1));  
  　　Delete(sTime,   1,   i);  
   
  　　if   UpperCase(Copy(sTime,   1,   3))   =   'HKT'   then  
  　　begin  
  　　　DT   :=   EncodeDate(systim.wYear,   systim.wMonth,   systim.wDay);  
  　　　DT   :=   DT   +   ti;  
  　　　DT   :=   DT   -   (8/24);   //   HK   Time   to   UTC   (香港时间转换到国际标准时间)  
  　　　DTReady   :=   True;  
  　　end;  
  　end;  
  end;  
   
  end.  
 

Unit  
  NMTime  
   
  Description  
  The   TNMTime   component   is   used   for   getting   the   time   from   Internet   time   servers,   as   described   in   RFC   868.

分给我.

SetWindowHookEx不能HOOK命令行（cmd.exe） Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiAPI/html/delphi_20061203132155126.html
最近写了个API   HOOK的小软件  
  利用SetWindowHookEx   实现对所有进程的HOOK  
  但是发现   SetWindowHookEx   （WH_WH_GETMESSAGE）对cmd.exe   不起作用(平台WIN2003)，后来我又试了   WH_CALLWNDPROCRET   ，WH_KEYBOARD   ，WH_MOUSE   ，都对cmd.exe不起作用     ，想请教下是否有别的方法进入cmd.exe的进程，利用CreateRemoteThread是可以注入cmd.exe的，但总不能用时钟来刷新进程列表，发现cmd.exe就注入吧，SetWindowHookEx本是我认为的最好的办法，但发现对cmd.exe不起作用，所以想请教下是否还有别的更好的办法，谢谢

是不支持的!  
  Hook   API,监控CreateProcess相关API,就不需要用时钟来刷新进程列表

感谢楼上的答复，我回去尝试下

看到你名字里的网址，才想起我还从你那下过东西呢  
  高手就是高手，在你面前总有“我怎么就没想到”的那种感觉  
  在《SetWindowHookEx不能HOOK命令行（cmd.exe）   》  
  您让我“监控CreateProcess相关API”  
  我回去尝试了下，效果是有的，但是在对cmd.exe的时候，好象还有点小问题  
   
  我先将我的尝试步骤说下：  
  1.我先   HOOK   CreateProcess   ，替换为一个同格式和参数的空函数，效果为不能运行任何新的进程，包括cmd.exe   说明   HOOK   CreateProcess   的做法是正确的，也达到了目的了  
  2.接着我写了个远程线程注入的函数，根据进程ID   来进程注入   测试成功  
  3.然后我又写了个   CreateProcess   的例子，函数的最后一个参数返回了创建的进程的ID   等信息  
   
  看来是完全可行的，于是我修改了APIHOOK的那个DLL，将CreateProcess   HOOK  
  替换CreateProcess的自定义函数里，我返回原函数的结果，让新的自定义的CreateProcess函数能达到原函数的效果，同时在后面加了   注入线程的函数，将原CreateProcess返回里最后个参数的返回的进程的ID   做为参数，理论上是能成功达到我的目的的，但是测试发现，别的进程都能成功注入，我测试了很多，包括VBS   脚本，但是   cmd.exe   依然没能注入，上面测试了   手工   注入cmd.exe是可行的   ，但为什么在以CreateProcess返回的进程ID为参数时，会出现cmd.exe   不能被注入，其他的都可以的，这让我百思不得其解，所以就给您发消息，希望能再次获得您的帮助   谢谢

新手急求多线程解决方案。 Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiAPI/html/delphi_20061203032448127.html
我刚接触   多线程编程，现在急着要处理一个任务。不得已拿这样初级问题询问各位大虾解决方案，还请不吝赐教，谢谢你们拉。^-^!  
   
  从数据库1表A中取出所有数据循环处理每一条记录（数据处理过程速度有点慢）  
  处理一条记录后修改日志数据库2表B（本次处理多少条记录）；  
  同时修改处理进度数据库3表C（对表A总共处理了多少记录）。  
  还需要用多线程来实现进度条显示处理过程  
   
  单线程处理的话速度有点慢，请大虾们给个建议呀！

这是我第一次“沙发”

别老做沙发啊！大哥  
  兄弟急呀

高手们在吗？急死拉

求一些api 谢谢 Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiAPI/html/delphi_20061202201055128.html
1、一个4位10进制的数组，转换为16位2进制后存储至另一数组  
   
  2、转完后，将该数组以及它的反码赋值给一个32位2进制数组  
   
  3、延迟5ms  
   
   
  请给出具体写法。谢谢

上面两个不清楚，第三个可以用API  
  Sleep(5)

这是小可注册CSDN一个月来见过的最强一贴。已收藏。盼高手来解答

谢谢woshihaoge(支离破碎)   ...  
   
  lihuasoft(学习低调做人)   不要笑我嘛~``偶刚开始学~``  
 

不是笑你。真的。我想，这个问题肯定能有办法解决的。但我不会。

有办法，可惜今晚喝多了，嘿嘿，明天来

十进制数循环除2，直到商为0，取每次的余数。  
    repeat        
              result:=table[1234     mod     2]+result;        
              a:=a       div       b;        
      until       a=0;  
   
  反码是什么?   0<-->1   ?如果是那也太简单了吧??   不用我说了哈..

re:dfsy427()       恩   谢谢  
   
  呵呵   就是0<->1   我记得有个写法可以直接对一串数字的数组取反  
   
  请问能不能这样写:  
  Array32:=Array16+Not[Array16]   //Array16为转换完的16为2进制数组

数组A[   array[0..16]   of   integer   ]附值给数组B[   array[0..32]   of   integer   ]是怎么弄的~~  
  不要说是一个个附值哦~~~~~```

16位2进制   你这么定义的问题。。  
  输出格式都没。。

拆分汉字字符串 Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiAPI/html/delphi_20061202180701129.html
比如有一字符串    
  s:=‘真的好喜欢你’；  
  现在要把他分成  
  array     f[0]:=‘真’；  
                f[1]:='的   '；  
                ...........  
                f[5]:='你'；  
  能写出详细的过程吗   有分的哦

var  
      Idx:   Integer;  
      Str:   String;  
      Arr:   array   of   WideString;  
      Len:   Integer;  
  begin  
      Len   :=   0;  
      Str   :=   'I我LOVE爱YOU你';  
      for   Idx   :=   0   to   Length(WideString(Str))   do  
      begin  
          if   Ord(WideString(Str)[Idx])   >=   $1000   then  
          begin  
              Inc(Len);  
              SetLength(Arr,   Len);  
              Arr[Pred(Len)]   :=   WideString(Str)[Idx];  
          end;  
      end;  
  end;

var  
      str:string;  
      arr:array[0..6]   of   string;  
      I,J:integer;  
  begin  
      str:='我真的好喜欢你';  
      J:=1;  
      for   I   :=   0   to   6   do  
              begin  
              arr[I]:=str[J]+str[J+1];  
              inc(J,2);  
              end;  
      for   I:=0   to   6   do  
      //edit1.Text:=edit1.Text+arr[I];  
  end;

var  
  f,g:string;  
  i,j,k:integer;  
  begin  
  g:='喜欢你';  
  j:=length(g);  
  for   i:=1   to   j   do  
  begin  
  if   (i   mod   2   <>   0   )   then  
  begin  
  f:=midstr(g,i,2);  
  showmessage(f);  
  //showmessage(inttostr(i));  
    end;  
  end;  
  end;  
   
  扼   我自己也想了一个出来     又学到了  
  哈哈       每人25分吧  
 

请问各位如何用Delphi控制U盘的安全拔出？？？？已经有源代码,但是不知道如何控制指定的U盘 Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiAPI/html/delphi_20061202153021130.html
请问各位如何用Delphi控制U盘的安全拔出？？？？已经有源代码,但是不知道如何控制指定的U盘

那个帖看见了，这个帖还没人来，我蹭分先

嘻嘻~

你不是已经有源代码了吗？  
  就在一个消息处理函数（wndpro），拦截了U盘拔出和插入的消息，然后就可以自己添加一些语句来记录。

具体修改不懂！！帮帮我好吗？？？我把代码发上！！  
  const  
      CfgMgr32ModuleName                 =   'cfgmgr32.dll';  
      SetupApiModuleName                 =   'SetupApi.dll';  
      REGSTR_VAL_NODISPLAYCLASS   =   'NoDisplayClass';  
      CR_SUCCESS                                 =   $00000000;  
      CR_REMOVE_VETOED                     =   $00000017;  
      DN_HAS_PROBLEM                         =   $00000400;  
      DN_DISABLEABLE                         =   $00002000;  
      DN_REMOVABLE                             =   $00004000;  
      DN_NO_SHOW_IN_DM                     =   $40000000;  
      CM_PROB_DISABLED                     =   $00000016;  
      CM_PROB_HARDWARE_DISABLED   =   $0000001D;  
   
  type  
      _PNP_VETO_TYPE   =   (  
            PNP_VetoTypeUnknown,  
            PNP_VetoLegacyDevice,  
            PNP_VetoPendingClose,  
            PNP_VetoWindowsApp,  
            PNP_VetoWindowsService,  
            PNP_VetoOutstandingOpen,  
            PNP_VetoDevice,  
            PNP_VetoDriver,  
            PNP_VetoIllegalDeviceRequest,  
            PNP_VetoInsufficientPower,  
            PNP_VetoNonDisableable,  
            PNP_VetoLegacyDriver  
      );  
      PNP_VETO_TYPE   =   _PNP_VETO_TYPE;  
      PPNP_VETO_TYPE   =   ^_PNP_VETO_TYPE;  
      TPNPVetoType   =   _PNP_VETO_TYPE;  
      PPNPVetoType   =   PPNP_VETO_TYPE;  
   
      function   CM_Get_DevNode_Status(pulStatus:   PULong;   pulProblemNumber:   PULong;  
      dnDevInst:   DWord;   ulFlags:   ULong):   DWord;   stdcall;  
      external   CfgMgr32ModuleName   name   'CM_Get_DevNode_Status';  
   
      function   CM_Request_Device_Eject(dnDevInst:   DWord;   out   pVetoType:   TPNPVetoType;  
      pszVetoName:   PChar;   ulNameLength:   ULong;   ulFlags:   ULong):   DWord;   stdcall;  
      external   SetupApiModuleName   name   'CM_Request_Device_EjectA';  
   
  type  
      TForm1   =   class(TForm)  
          TreeView:   TTreeView;  
          ImageList:   TImageList;  
          MainMenu1:   TMainMenu;  
          Eject1:   TMenuItem;  
          Exit1:   TMenuItem;  
          Change1:   TMenuItem;  
          ShowHidden1:   TMenuItem;  
          EjectDriver1:   TMenuItem;  
          Exit2:   TMenuItem;  
          procedure   FormCreate(Sender:   TObject);  
          procedure   ShowHidden1Click(Sender:   TObject);  
          procedure   FormCloseQuery(Sender:   TObject;   var   CanClose:   Boolean);  
          procedure   EjectDriver1Click(Sender:   TObject);  
          procedure   Exit2Click(Sender:   TObject);  
          procedure   TreeViewClick(Sender:   TObject);  
      private  
          DevInfo:   hDevInfo;  
          ClassImageListData:   TSPClassImageListData;  
          ShowHidden:   Boolean;  
          function   EnumAddDevices(ShowHidden:   Boolean;   hwndTree:   TTreeView;   DevInfo:   hDevInfo):   Boolean;  
          function   IsClassHidden(ClassGuid:   TGuid):   Boolean;  
          function   GetRegistryProperty(PnPHandle:   hDevInfo;   DevData:   TSPDevInfoData;  
                            Prop:   DWord;   Buffer:   PChar;   dwLength:   DWord):   Boolean;  
          function   ConstructDeviceName(DeviceInfoSet:   hDevInfo;  
                            DeviceInfoData:   TSPDevInfoData;   Buffer:   PChar;   dwLength:   DWord):   Boolean;  
          function   GetClassImageIndex(ClassGuid:   TGuid;   Index:   PInt):   Boolean;  
          function   GetDevInfo(var   hDevInfo:   hDevInfo):   boolean;  
   
   
          {   Private   declarations   }  
      public  
          {   Public   declarations   }  
      end;  
   
  var  
      Form1:   TForm1;  
   
  implementation  
   
  {$R   *.dfm}  
   
  function   TForm1.GetDevInfo(var   hDevInfo:   hDevInfo):   boolean;  
  begin  
      if   (assigned(DevInfo))   then  
      begin  
          SetupDiDestroyDeviceInfoList(DevInfo);  
          SetupDiDestroyClassImageList(ClassImageListData);  
      end;  
      //   Get   a   handle   to   all   devices   in   all   classes   present   on   system  
      DevInfo   :=   SetupDiGetClassDevs(nil,   nil,   0,   DIGCF_PRESENT   or   DIGCF_ALLCLASSES);  
      if   (DevInfo   =   Pointer(INVALID_HANDLE_VALUE))   then  
      begin  
          ShowMessage('GetClassDevs');  
          exit;  
      end;  
      //   Get   the   Images   for   all   classes,   and   bind   to   the   TreeView  
      ClassImageListData.cbSize   :=   SizeOf(TSPClassImageListData);  
      if   (not   SetupDiGetClassImageList(ClassImageListData))   then  
      begin  
          ShowMessage('GetClassImageList');  
          exit;  
      end;  
      ImageList.Handle   :=   ClassImageListData.ImageList;  
      TreeView.Images   :=   ImageList;  
  end;  
   
  function   TForm1.GetClassImageIndex(ClassGuid:   TGuid;   Index:   PInt):   Boolean;  
  begin  
      Result   :=   SetupDiGetClassImageIndex(ClassImageListData,   ClassGuid,   Index^);  
  end;  
   
  function   TForm1.GetRegistryProperty(PnPHandle:   hDevInfo;   DevData:   TSPDevInfoData;   Prop:   DWord;   Buffer:   PChar;   dwLength:   DWord):   Boolean;  
  var  
      aBuffer:   array[0..256]   of   Char;  
  begin  
      dwLength   :=   0;  
      aBuffer[0]   :=   #0;  
      SetupDiGetDeviceRegistryProperty(PnPHandle,   DevData,   Prop,   Prop,   PBYTE(@aBuffer[0]),   SizeOf(aBuffer),   dwLength);  
      StrCopy(Buffer,   aBuffer);  
      Result   :=   Buffer^   <>   #0;  
  end;  
  function   TForm1.ConstructDeviceName(DeviceInfoSet:   hDevInfo;  
                    DeviceInfoData:   TSPDevInfoData;   Buffer:   PChar;   dwLength:   DWord):   Boolean;  
  const  
      UnknownDevice   =   '<Unknown   Device>';  
  begin  
      if   (not   GetRegistryProperty(DeviceInfoSet,   DeviceInfoData,   SPDRP_FRIENDLYNAME,   Buffer,   dwLength))   then  
      begin  
          if   (not   GetRegistryProperty(DeviceInfoSet,   DeviceInfoData,   SPDRP_DEVICEDESC,   Buffer,   dwLength))   then  
          begin  
              if   (not   GetRegistryProperty(DeviceInfoSet,   DeviceInfoData,   SPDRP_CLASS,   Buffer,   dwLength))   then  
              begin  
                  if   (not   GetRegistryProperty(DeviceInfoSet,   DeviceInfoData,   SPDRP_CLASSGUID,   Buffer,   dwLength))   then  
                  begin  
                      dwLength   :=   DWord(SizeOf(UnknownDevice));  
                      Buffer   :=   Pointer(LocalAlloc(LPTR,   Cardinal(dwLength)));  
                      StrCopy(Buffer,   UnknownDevice);  
                  end;  
              end;  
          end;  
      end;  
      Result   :=   true;  
  end;  
   
  function   TForm1.IsClassHidden(ClassGuid:   TGuid):   Boolean;  
  var  
      bHidden:   Boolean;  
      hKeyClass:   HKey;  
  begin  
      bHidden   :=   false;  
      hKeyClass   :=   SetupDiOpenClassRegKey(@ClassGuid,   KEY_READ);  
      if   (hKeyClass   <>   0)   then  
      begin  
          bHidden   :=   (RegQueryValueEx(hKeyClass,   REGSTR_VAL_NODISPLAYCLASS,   nil,   nil,   nil,   nil)   =   ERROR_SUCCESS);  
          RegCloseKey(hKeyClass);  
      end;  
      Result   :=   bHidden;  
  end;

 
   
  function   TForm1.EnumAddDevices(ShowHidden:   Boolean;   hwndTree:   TTreeView;   DevInfo:   hDevInfo):   Boolean;  
  var  
      i,   Status,   Problem:   DWord;  
      pszText:   PChar;  
      DeviceInfoData:   TSPDevInfoData;  
      iImage:   Integer;  
  begin  
      TTreeView(hWndTree).Items.BeginUpdate;  
      DeviceInfoData.cbSize   :=   SizeOf(TSPDevInfoData);  
      //   Clean   off   all   the   items   in   a   TreeView.  
      TTreeView(hWndTree).Items.Clear;  
      i   :=   0;  
      //   Enumerate   though   all   the   devices.  
      while   SetupDiEnumDeviceInfo(DevInfo,   i,   DeviceInfoData)   do  
      begin  
          inc(i);  
          //   Should   we   display   this   device,   or   move   onto   the   next   one.  
          if   (CM_Get_DevNode_Status(@Status,   @Problem,   DeviceInfoData.DevInst,   0)   <>   CR_SUCCESS)   then  
          begin  
              break;  
          end;  
          if   (not   (ShowHidden   or   not(Boolean(Status   and   DN_NO_SHOW_IN_DM)   or   IsClassHidden(DeviceInfoData.ClassGuid))))   then  
          begin  
              break;  
          end;  
          GetMem(pszText,   256);  
          try  
              //   Get   a   friendly   name   for   the   device.  
              ConstructDeviceName(DevInfo,   DeviceInfoData,   pszText,   DWord(nil));  
              //   Try   to   get   an   icon   index   for   this   device.  
              if   (GetClassImageIndex(DeviceInfoData.ClassGuid,   @iImage))   then  
              begin  
                  with   TTreeView(hWndTree).Items.AddObject(nil,   pszText,   nil)   do  
                  begin  
                      TTreeView(hWndTree).Items[i-1].ImageIndex   :=   iImage;  
                      TTreeView(hWndTree).Items[i-1].SelectedIndex   :=   iImage;  
                  end;  
                  if   (Problem   =   CM_PROB_DISABLED)   then   //   red   (X)  
                  begin  
                          TTreeView(hWndTree).Items[i-1].OverlayIndex   :=   IDI_DISABLED_OVL   -   IDI_CLASSICON_OVERLAYFIRST;  
                  end   else  
                  begin  
                      if   (Boolean(Problem))   then   //   yellow   (!)  
                      begin  
                              TTreeView(hWndTree).Items[i-1].OverlayIndex   :=   IDI_PROBLEM_OVL   -   IDI_CLASSICON_OVERLAYFIRST;  
                      end;  
                  end;  
                  if   (Status   and   DN_NO_SHOW_IN_DM   =   DN_NO_SHOW_IN_DM)   then   //   Greyed   out  
                  begin  
                      TTreeView(hWndTree).Items[i-1].Cut   :=   true;  
                  end;  
              end;  
          finally  
              FreeMem(pszText);  
          end;  
      end;  
      TTreeView(hWndTree).Items.EndUpdate;  
      Result   :=   true;  
  end;  
   
  procedure   TForm1.FormCreate(Sender:   TObject);  
  begin  
      if   (not   LoadSetupAPI)   then  
      begin  
      ShowMessage('Could   not   load   SetupAPI.dll');  
      exit;            
      end;            
      DevInfo       :=       nil;            
      ShowHidden       :=       false;            
      //       Get       a       handle       to       all       devices       in       all       classes       present       on       system            
      if       not       GetDevInfo(DevInfo)       then  
      begin            
      ShowMessage('GetClassDevs');            
      exit;            
      end;            
      //       Get       the       Images       for       all       classes,       and       bind       to       the       TreeView            
      ClassImageListData.cbSize       :=       SizeOf(TSPClassImageListData);            
      if       (not       SetupDiGetClassImageList(ClassImageListData))       then            
      begin            
      ShowMessage('GetClassImageList');            
      exit;            
      end;            
      ImageList.Handle       :=       ClassImageListData.ImageList;            
      TreeView.Images       :=       ImageList;            
      //       Add       the       devices       to       the       TreeView       window.  
      EnumAddDevices(ShowHidden,       TreeView,       DevInfo);  
  end;  
   
  procedure   TForm1.EjectDriver1Click(Sender:   TObject);  
  var  
      DeviceInfoData:   TSPDevInfoData;  
      Status,   Problem:   DWord;  
      VetoType:   TPNPVetoType;  
      VetoName:   array[0..256]   of   Char;  
  begin  
          DeviceInfoData.cbSize   :=   SizeOf(TSPDevInfoData);  
          //   Get   a   handle   to   the   Selected   Item.  
          if   (not   SetupDiEnumDeviceInfo(DevInfo,   TreeView.Selected.Index,   DeviceInfoData))   then  
          begin  
              exit;  
          end;  
          if   (CM_Get_DevNode_Status(@Status,   @Problem,   DeviceInfoData.DevInst,   0)   <>   CR_SUCCESS)   then  
          begin  
              exit;  
          end;  
          VetoName[0]   :=   #0;  
        case       CM_Request_Device_Eject(DeviceInfoData.DevInst,       VetoType,       @VetoName,       SizeOf(VetoName),       0)       of  
          CR_SUCCESS:  
          begin  
            MessageBox(Handle,   'Successful   to   eject   the   Device',   'Done',   MB_OK);  
          if   not   GetDevInfo(DevInfo)   then  
              begin  
              ShowMessage('GetClassDevs');  
              end;  
                  EnumAddDevices(ShowHidden,   TreeView,   DevInfo);  
              end;  
              CR_REMOVE_VETOED:  
              begin  
                  MessageBox(Handle,   PChar('Failed   to   eject   the   Device   (Veto:   '   +   VetoName   +   ')'),   'Vetoed',   MB_OK);  
              end;  
              else  
              begin  
                  MessageBox(Handle,   PChar('Failed   to   eject   the   Device   ('   +   SysErrorMessage(GetLastError)   +   ')'),   'Failure',   MB_OK);  
              end;  
          end;                  
  end;  
   
  procedure   TForm1.ShowHidden1Click(Sender:   TObject);  
  begin  
      ShowHidden   :=   not   ShowHidden;  
      EnumAddDevices(ShowHidden,   TreeView,   DevInfo);  
  end;  
   
  procedure   TForm1.FormCloseQuery(Sender:   TObject;   var   CanClose:   Boolean);  
  begin  
  canclose:=application.MessageBox('你真的要退出吗？','系统提示',mb_yesno+MB_ICONQUESTION)=idyes   ;  
  if   canclose   then  
  begin  
  Application.Terminate;  
  end;  
  end;  
   
  procedure   TForm1.Exit2Click(Sender:   TObject);  
  begin  
  Close;  
  end;  
   
  end.  
 

ly_liuyang(Liu   Yang   LYSoft   http://lysoft.7u7.net)    
  大牛都灌水，。。。

不用钩子 截获系统消息! Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiAPI/html/delphi_20061202122312131.html
有办法？

没有~

特定消息.   -->   windows   dll-->修改该   dll

mark

求一類似 GetFileVersionInfo 的函數，返回Exe文件開發的公司名稱 Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiAPI/html/delphi_20061202120619132.html
如題：  
  一個Exe文件一般除了版本信息外還有其它的信息。請教其它信息怎麼獲得。  
  比如   產品名稱，公司名稱，語言   等等。這些信息用代碼怎麼獲得。  
 

http://www.tapor.uvic.ca/~mholmes/source_code/Delphi2005/GenFunctions/GenFunctions.pas

老大,里面没有我要的啊,我不要查版本信息的.

查看下   pe格式...  
  具体写在什么位置   也不清楚  
  不行就自己分析下     用winhex   ...

有点乱，你自己改一下：  
   
  procedure   TForm1.GetVersionInfo;  
  const  
      SNotAvailable   =   'Value   Not   Available';  
  var  
      LanguageID:   string;  
      CodePage:   string;  
      TranslationLength:   Cardinal;  
      TranslationTable:   Pointer;  
      InfoSize,   Temp,   Len:   DWord;  
      InfoBuf:   Pointer;  
      CompanyName,   FileDescription,   FileVersion,   InternalName,   LegalCopyright:   string;  
      LegalTradeMarks,   OriginalFilename,   ProductName,   ProductVersion,   Comments:   string;  
      Value:   PChar;  
      LookupString,FilePath:   string;  
      FVersionInfoAvailable:   Boolean;  
  begin  
      FilePath   :=   'c:\windows\Regedit.exe';  
      InfoSize   :=   GetFileVersionInfoSize(   PChar(FilePath   ),   Temp   );  
      FVersionInfoAvailable   :=   InfoSize   >   0;  
      if   FVersionInfoAvailable   then  
      begin  
          InfoBuf   :=   AllocMem(   InfoSize   );  
          try  
              GetFileVersionInfo(   PChar(   FilePath   ),   0,   InfoSize,   InfoBuf   );  
              if   VerQueryValue(   InfoBuf,   '\VarFileInfo\Translation',   TranslationTable,   TranslationLength   )   then  
              begin  
                  CodePage   :=   Format(   '%.4x',   [   HiWord(   PLongInt(   TranslationTable   )^   )   ]   );  
                  LanguageID   :=   Format(   '%.4x',   [   LoWord(   PLongInt(   TranslationTable   )^   )   ]   );  
              end;  
   
              LookupString   :=   'StringFileInfo\'   +   LanguageID   +   CodePage   +   '\';  
   
              if   VerQueryValue(   InfoBuf,   PChar(   LookupString   +   'CompanyName'   ),   Pointer(   Value   ),   Len   )   then  
                  CompanyName   :=   Value;  
              if   VerQueryValue(   InfoBuf,   PChar(   LookupString   +   'FileDescription'   ),   Pointer(   Value   ),   Len   )   then  
                  FileDescription   :=   Value;  
              if   VerQueryValue(   InfoBuf,   PChar(   LookupString   +   'FileVersion'   ),   Pointer(   Value   ),   Len   )   then  
                  FileVersion   :=   Value;  
              if   VerQueryValue(   InfoBuf,   PChar(   LookupString   +   'InternalName'   ),   Pointer(   Value   ),   Len   )   then  
                  InternalName   :=   Value;  
              if   VerQueryValue(   InfoBuf,   PChar(   LookupString   +   'LegalCopyright'   ),   Pointer(   Value   ),   Len   )   then  
                  LegalCopyright   :=   Value;  
              if   VerQueryValue(   InfoBuf,   PChar(   LookupString   +   'LegalTrademarks'   ),   Pointer(   Value   ),   Len   )   then  
                  LegalTradeMarks   :=   Value;  
              if   VerQueryValue(   InfoBuf,   PChar(   LookupString   +   'OriginalFilename'   ),   Pointer(   Value   ),   Len   )   then  
                  OriginalFilename   :=   Value;  
              if   VerQueryValue(   InfoBuf,   PChar(   LookupString   +   'ProductName'   ),   Pointer(   Value   ),   Len   )   then  
                  ProductName   :=   Value;  
              if   VerQueryValue(   InfoBuf,   PChar(   LookupString   +   'ProductVersion'   ),   Pointer(   Value   ),   Len   )   then  
                  ProductVersion   :=   Value;  
              if   VerQueryValue(   InfoBuf,   PChar(   LookupString   +   'Comments'   ),   Pointer(   Value   ),   Len   )   then  
                  Comments   :=   Value;  
          finally  
              FreeMem(   InfoBuf,   InfoSize   );  
          end;  
      end  
      else  
      begin  
          CompanyName   :=   SNotAvailable;  
          FileDescription   :=   SNotAvailable;  
          FileVersion   :=   SNotAvailable;  
          InternalName   :=   SNotAvailable;  
          LegalCopyright   :=   SNotAvailable;  
          LegalTrademarks   :=   SNotAvailable;  
          OriginalFilename   :=   SNotAvailable;  
          ProductName   :=   SNotAvailable;  
          ProductVersion   :=   SNotAvailable;  
          Comments   :=   SNotAvailable;  
      end;  
      Memo1.Lines.Clear;  
      Memo1.Lines.Add(   CompanyName   );  
      Memo1.Lines.Add(   FileDescription   );  
      Memo1.Lines.Add(   FileVersion   );  
      Memo1.Lines.Add(   InternalName   );  
      Memo1.Lines.Add(   LegalCopyright   );  
      Memo1.Lines.Add(   LegalTrademarks   );  
      Memo1.Lines.Add(   OriginalFilename   );  
      Memo1.Lines.Add(   ProductName   );  
      Memo1.Lines.Add(   ProductVersion   );  
      Memo1.Lines.Add(   Comments   );  
  end;

哈哈，俺要的就是這個!謝謝老之!  
  跪倒!叩拜!:)

请问各位如何用Delphi控制U盘的安全拔出？？？？已经有源代码,但是不知道如何控制指定的U盘 Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiAPI/html/delphi_20061202105306133.html
请问各位如何用Delphi控制U盘的安全拔出？？？？已经有源代码,但是不知道如何控制指定的U盘

const  
      CfgMgr32ModuleName                 =   'cfgmgr32.dll';  
      SetupApiModuleName                 =   'SetupApi.dll';  
      REGSTR_VAL_NODISPLAYCLASS   =   'NoDisplayClass';  
      CR_SUCCESS                                 =   $00000000;  
      CR_REMOVE_VETOED                     =   $00000017;  
      DN_HAS_PROBLEM                         =   $00000400;  
      DN_DISABLEABLE                         =   $00002000;  
      DN_REMOVABLE                             =   $00004000;  
      DN_NO_SHOW_IN_DM                     =   $40000000;  
      CM_PROB_DISABLED                     =   $00000016;  
      CM_PROB_HARDWARE_DISABLED   =   $0000001D;  
   
  type  
      _PNP_VETO_TYPE   =   (  
            PNP_VetoTypeUnknown,  
            PNP_VetoLegacyDevice,  
            PNP_VetoPendingClose,  
            PNP_VetoWindowsApp,  
            PNP_VetoWindowsService,  
            PNP_VetoOutstandingOpen,  
            PNP_VetoDevice,  
            PNP_VetoDriver,  
            PNP_VetoIllegalDeviceRequest,  
            PNP_VetoInsufficientPower,  
            PNP_VetoNonDisableable,  
            PNP_VetoLegacyDriver  
      );  
      PNP_VETO_TYPE   =   _PNP_VETO_TYPE;  
      PPNP_VETO_TYPE   =   ^_PNP_VETO_TYPE;  
      TPNPVetoType   =   _PNP_VETO_TYPE;  
      PPNPVetoType   =   PPNP_VETO_TYPE;  
   
      function   CM_Get_DevNode_Status(pulStatus:   PULong;   pulProblemNumber:   PULong;  
      dnDevInst:   DWord;   ulFlags:   ULong):   DWord;   stdcall;  
      external   CfgMgr32ModuleName   name   'CM_Get_DevNode_Status';  
   
      function   CM_Request_Device_Eject(dnDevInst:   DWord;   out   pVetoType:   TPNPVetoType;  
      pszVetoName:   PChar;   ulNameLength:   ULong;   ulFlags:   ULong):   DWord;   stdcall;  
      external   SetupApiModuleName   name   'CM_Request_Device_EjectA';  
   
  type  
      TForm1   =   class(TForm)  
          TreeView:   TTreeView;  
          ImageList:   TImageList;  
          MainMenu1:   TMainMenu;  
          Eject1:   TMenuItem;  
          Exit1:   TMenuItem;  
          Change1:   TMenuItem;  
          ShowHidden1:   TMenuItem;  
          EjectDriver1:   TMenuItem;  
          Exit2:   TMenuItem;  
          procedure   FormCreate(Sender:   TObject);  
          procedure   ShowHidden1Click(Sender:   TObject);  
          procedure   FormCloseQuery(Sender:   TObject;   var   CanClose:   Boolean);  
          procedure   EjectDriver1Click(Sender:   TObject);  
          procedure   Exit2Click(Sender:   TObject);  
          procedure   TreeViewClick(Sender:   TObject);  
      private  
          DevInfo:   hDevInfo;  
          ClassImageListData:   TSPClassImageListData;  
          ShowHidden:   Boolean;  
          function   EnumAddDevices(ShowHidden:   Boolean;   hwndTree:   TTreeView;   DevInfo:   hDevInfo):   Boolean;  
          function   IsClassHidden(ClassGuid:   TGuid):   Boolean;  
          function   GetRegistryProperty(PnPHandle:   hDevInfo;   DevData:   TSPDevInfoData;  
                            Prop:   DWord;   Buffer:   PChar;   dwLength:   DWord):   Boolean;  
          function   ConstructDeviceName(DeviceInfoSet:   hDevInfo;  
                            DeviceInfoData:   TSPDevInfoData;   Buffer:   PChar;   dwLength:   DWord):   Boolean;  
          function   GetClassImageIndex(ClassGuid:   TGuid;   Index:   PInt):   Boolean;  
          function   GetDevInfo(var   hDevInfo:   hDevInfo):   boolean;  
   
   
          {   Private   declarations   }  
      public  
          {   Public   declarations   }  
      end;  
   
  var  
      Form1:   TForm1;  
   
  implementation  
   
  {$R   *.dfm}  
   
  function   TForm1.GetDevInfo(var   hDevInfo:   hDevInfo):   boolean;  
  begin  
      if   (assigned(DevInfo))   then  
      begin  
          SetupDiDestroyDeviceInfoList(DevInfo);  
          SetupDiDestroyClassImageList(ClassImageListData);  
      end;  
      //   Get   a   handle   to   all   devices   in   all   classes   present   on   system  
      DevInfo   :=   SetupDiGetClassDevs(nil,   nil,   0,   DIGCF_PRESENT   or   DIGCF_ALLCLASSES);  
      if   (DevInfo   =   Pointer(INVALID_HANDLE_VALUE))   then  
      begin  
          ShowMessage('GetClassDevs');  
          exit;  
      end;  
      //   Get   the   Images   for   all   classes,   and   bind   to   the   TreeView  
      ClassImageListData.cbSize   :=   SizeOf(TSPClassImageListData);  
      if   (not   SetupDiGetClassImageList(ClassImageListData))   then  
      begin  
          ShowMessage('GetClassImageList');  
          exit;  
      end;  
      ImageList.Handle   :=   ClassImageListData.ImageList;  
      TreeView.Images   :=   ImageList;  
  end;  
   
  function   TForm1.GetClassImageIndex(ClassGuid:   TGuid;   Index:   PInt):   Boolean;  
  begin  
      Result   :=   SetupDiGetClassImageIndex(ClassImageListData,   ClassGuid,   Index^);  
  end;  
   
  function   TForm1.GetRegistryProperty(PnPHandle:   hDevInfo;   DevData:   TSPDevInfoData;   Prop:   DWord;   Buffer:   PChar;   dwLength:   DWord):   Boolean;  
  var  
      aBuffer:   array[0..256]   of   Char;  
  begin  
      dwLength   :=   0;  
      aBuffer[0]   :=   #0;  
      SetupDiGetDeviceRegistryProperty(PnPHandle,   DevData,   Prop,   Prop,   PBYTE(@aBuffer[0]),   SizeOf(aBuffer),   dwLength);  
      StrCopy(Buffer,   aBuffer);  
      Result   :=   Buffer^   <>   #0;  
  end;

 
   
  function   TForm1.ConstructDeviceName(DeviceInfoSet:   hDevInfo;  
                    DeviceInfoData:   TSPDevInfoData;   Buffer:   PChar;   dwLength:   DWord):   Boolean;  
  const  
      UnknownDevice   =   '<Unknown   Device>';  
  begin  
      if   (not   GetRegistryProperty(DeviceInfoSet,   DeviceInfoData,   SPDRP_FRIENDLYNAME,   Buffer,   dwLength))   then  
      begin  
          if   (not   GetRegistryProperty(DeviceInfoSet,   DeviceInfoData,   SPDRP_DEVICEDESC,   Buffer,   dwLength))   then  
          begin  
              if   (not   GetRegistryProperty(DeviceInfoSet,   DeviceInfoData,   SPDRP_CLASS,   Buffer,   dwLength))   then  
              begin  
                  if   (not   GetRegistryProperty(DeviceInfoSet,   DeviceInfoData,   SPDRP_CLASSGUID,   Buffer,   dwLength))   then  
                  begin  
                      dwLength   :=   DWord(SizeOf(UnknownDevice));  
                      Buffer   :=   Pointer(LocalAlloc(LPTR,   Cardinal(dwLength)));  
                      StrCopy(Buffer,   UnknownDevice);  
                  end;  
              end;  
          end;  
      end;  
      Result   :=   true;  
  end;  
   
  function   TForm1.IsClassHidden(ClassGuid:   TGuid):   Boolean;  
  var  
      bHidden:   Boolean;  
      hKeyClass:   HKey;  
  begin  
      bHidden   :=   false;  
      hKeyClass   :=   SetupDiOpenClassRegKey(@ClassGuid,   KEY_READ);  
      if   (hKeyClass   <>   0)   then  
      begin  
          bHidden   :=   (RegQueryValueEx(hKeyClass,   REGSTR_VAL_NODISPLAYCLASS,   nil,   nil,   nil,   nil)   =   ERROR_SUCCESS);  
          RegCloseKey(hKeyClass);  
      end;  
      Result   :=   bHidden;  
  end;  
   
  function   TForm1.EnumAddDevices(ShowHidden:   Boolean;   hwndTree:   TTreeView;   DevInfo:   hDevInfo):   Boolean;  
  var  
      i,   Status,   Problem:   DWord;  
      pszText:   PChar;  
      DeviceInfoData:   TSPDevInfoData;  
      iImage:   Integer;  
  begin  
      TTreeView(hWndTree).Items.BeginUpdate;  
      DeviceInfoData.cbSize   :=   SizeOf(TSPDevInfoData);  
      //   Clean   off   all   the   items   in   a   TreeView.  
      TTreeView(hWndTree).Items.Clear;  
      i   :=   0;  
      //   Enumerate   though   all   the   devices.  
      while   SetupDiEnumDeviceInfo(DevInfo,   i,   DeviceInfoData)   do  
      begin  
          inc(i);  
          //   Should   we   display   this   device,   or   move   onto   the   next   one.  
          if   (CM_Get_DevNode_Status(@Status,   @Problem,   DeviceInfoData.DevInst,   0)   <>   CR_SUCCESS)   then  
          begin  
              break;  
          end;  
          if   (not   (ShowHidden   or   not(Boolean(Status   and   DN_NO_SHOW_IN_DM)   or   IsClassHidden(DeviceInfoData.ClassGuid))))   then  
          begin  
              break;  
          end;  
          GetMem(pszText,   256);  
          try  
              //   Get   a   friendly   name   for   the   device.  
              ConstructDeviceName(DevInfo,   DeviceInfoData,   pszText,   DWord(nil));  
              //   Try   to   get   an   icon   index   for   this   device.  
              if   (GetClassImageIndex(DeviceInfoData.ClassGuid,   @iImage))   then  
              begin  
                  with   TTreeView(hWndTree).Items.AddObject(nil,   pszText,   nil)   do  
                  begin  
                      TTreeView(hWndTree).Items[i-1].ImageIndex   :=   iImage;  
                      TTreeView(hWndTree).Items[i-1].SelectedIndex   :=   iImage;  
                  end;  
                  if   (Problem   =   CM_PROB_DISABLED)   then   //   red   (X)  
                  begin  
                          TTreeView(hWndTree).Items[i-1].OverlayIndex   :=   IDI_DISABLED_OVL   -   IDI_CLASSICON_OVERLAYFIRST;  
                  end   else  
                  begin  
                      if   (Boolean(Problem))   then   //   yellow   (!)  
                      begin  
                              TTreeView(hWndTree).Items[i-1].OverlayIndex   :=   IDI_PROBLEM_OVL   -   IDI_CLASSICON_OVERLAYFIRST;  
                      end;  
                  end;  
                  if   (Status   and   DN_NO_SHOW_IN_DM   =   DN_NO_SHOW_IN_DM)   then   //   Greyed   out  
                  begin  
                      TTreeView(hWndTree).Items[i-1].Cut   :=   true;  
                  end;  
              end;  
          finally  
              FreeMem(pszText);  
          end;  
      end;  
      TTreeView(hWndTree).Items.EndUpdate;  
      Result   :=   true;  
  end;  
   
  procedure   TForm1.FormCreate(Sender:   TObject);  
  begin  
      if   (not   LoadSetupAPI)   then  
      begin  
      ShowMessage('Could   not   load   SetupAPI.dll');  
      exit;            
      end;            
      DevInfo       :=       nil;            
      ShowHidden       :=       false;            
      //       Get       a       handle       to       all       devices       in       all       classes       present       on       system            
      if       not       GetDevInfo(DevInfo)       then  
      begin            
      ShowMessage('GetClassDevs');            
      exit;            
      end;            
      //       Get       the       Images       for       all       classes,       and       bind       to       the       TreeView            
      ClassImageListData.cbSize       :=       SizeOf(TSPClassImageListData);            
      if       (not       SetupDiGetClassImageList(ClassImageListData))       then            
      begin            
      ShowMessage('GetClassImageList');            
      exit;            
      end;            
      ImageList.Handle       :=       ClassImageListData.ImageList;            
      TreeView.Images       :=       ImageList;            
      //       Add       the       devices       to       the       TreeView       window.  
      EnumAddDevices(ShowHidden,       TreeView,       DevInfo);  
  end;  
   
  procedure   TForm1.EjectDriver1Click(Sender:   TObject);  
  var  
      DeviceInfoData:   TSPDevInfoData;  
      Status,   Problem:   DWord;  
      VetoType:   TPNPVetoType;  
      VetoName:   array[0..256]   of   Char;  
  begin  
          DeviceInfoData.cbSize   :=   SizeOf(TSPDevInfoData);  
          //   Get   a   handle   to   the   Selected   Item.  
          if   (not   SetupDiEnumDeviceInfo(DevInfo,   TreeView.Selected.Index,   DeviceInfoData))   then  
          begin  
              exit;  
          end;  
          if   (CM_Get_DevNode_Status(@Status,   @Problem,   DeviceInfoData.DevInst,   0)   <>   CR_SUCCESS)   then  
          begin  
              exit;  
          end;  
          VetoName[0]   :=   #0;  
        case       CM_Request_Device_Eject(DeviceInfoData.DevInst,       VetoType,       @VetoName,       SizeOf(VetoName),       0)       of  
          CR_SUCCESS:  
          begin  
            MessageBox(Handle,   'Successful   to   eject   the   Device',   'Done',   MB_OK);  
          if   not   GetDevInfo(DevInfo)   then  
              begin  
              ShowMessage('GetClassDevs');  
              end;  
                  EnumAddDevices(ShowHidden,   TreeView,   DevInfo);  
              end;  
              CR_REMOVE_VETOED:  
              begin  
                  MessageBox(Handle,   PChar('Failed   to   eject   the   Device   (Veto:   '   +   VetoName   +   ')'),   'Vetoed',   MB_OK);  
              end;  
              else  
              begin  
                  MessageBox(Handle,   PChar('Failed   to   eject   the   Device   ('   +   SysErrorMessage(GetLastError)   +   ')'),   'Failure',   MB_OK);  
              end;  
          end;                  
  end;  
   
  procedure   TForm1.ShowHidden1Click(Sender:   TObject);  
  begin  
      ShowHidden   :=   not   ShowHidden;  
      EnumAddDevices(ShowHidden,   TreeView,   DevInfo);  
  end;  
   
  procedure   TForm1.FormCloseQuery(Sender:   TObject;   var   CanClose:   Boolean);  
  begin  
  canclose:=application.MessageBox('你真的要退出吗？','系统提示',mb_yesno+MB_ICONQUESTION)=idyes   ;  
  if   canclose   then  
  begin  
  Application.Terminate;  
  end;  
  end;  
   
  procedure   TForm1.Exit2Click(Sender:   TObject);  
  begin  
  Close;  
  end;  
   
  end.

呵呵~  
  这个也有源码的~

先收藏了，再试试

呵呵，mark!

如果在IDE中增加一项自己的菜单,求一实例 Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiAPI/html/delphi_20061202014927134.html
如果在IDE中增加一项自己的菜单,然后点击该菜单又弹出自己定义的某个窗口!!  
  给个实例吧,谢谢!!

用ToolsAPI

uses   ToolsAPI;  
   
  var  
      NTAServices:   INTAServices;  
      _MainMenu:   TMainMenu;  
      _MenuItem:   TMenuItem;  
  begin  
      NTAServices   :=   BorlandIDEServices   as   INTAServices;  
      _MainMenu   :=   NTAServices.MainMenu;  
      _MenuItem   :=   TMenuItem.Create(Self);  
      _MenuItem.Caption   :=   'Sanmaotuo';  
      _MenuItem.OnClick   :=   MenuItemClick;  
      _MainMenu.Items.Add(_MenuItem);  
  end;  
   
  procedure   MenuItemClick(Sender:   TObject);  
  begin  
      with   TSanmaotuoForm.Create(Self)   do  
          Show;  
  end;

有没有相关资料啊,上面的代码好像是要做成DLL?

直接加入到包(Package)中再Compile+Install就OK了.很简单的.

顶冯老弟  
 

我还是不太明白一下代码要写在什么地方  
  var  
      NTAServices:   INTAServices;  
      _MainMenu:   TMainMenu;  
      _MenuItem:   TMenuItem;  
  begin  
      NTAServices   :=   BorlandIDEServices   as   INTAServices;  
      _MainMenu   :=   NTAServices.MainMenu;  
      _MenuItem   :=   TMenuItem.Create(Self);  
      _MenuItem.Caption   :=   'Sanmaotuo';  
      _MenuItem.OnClick   :=   MenuItemClick;  
      _MainMenu.Items.Add(_MenuItem);  
  end;  
  看来要查查资料了

老冯说的很清楚,新建一个包,将单元加入,编译安装即可  
 

我是安装了啊,却不知道,菜单在哪里?  
  且也不明白这段代码是在什么时候执行到的  
  NTAServices   :=   BorlandIDEServices   as   INTAServices;  
      _MainMenu   :=   NTAServices.MainMenu;  
      _MenuItem   :=   TMenuItem.Create(Self);  
      _MenuItem.Caption   :=   'Sanmaotuo';  
      _MenuItem.OnClick   :=   MenuItemClick;  
      _MainMenu.Items.Add(_MenuItem);

在initialization部分搞定了

在initialization部分搞定了  
   
  ----------------------------  
   
  好  
 

编写批处理文件时传入多个参数的问题 Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiAPI/html/delphi_20061201225247135.html
我的程序需要调用一个dos程序mydos.exe，该程序在运行结束时需要输入参数，并且是两个，我现在的做法是：先编写一个文本文件mytext.txt，把需要输入的参数记录在里面，比如“10   10”，然后便写一个bat文件，这样写：  
  @echo   off  
  path/mydos.exe   <   path/mytest.txt  
   
  然后createprocess运行该bat文件，但结果运行却不正常。我试过另一个dos程序，该程序一开始便需要输入参数，并只有一个参数，结果却能正常运行。我的问题是，究竟是输入参数的时间错误还是输入参数的方式错误呢？  
   
  多谢！

DOS   的文件夹分隔符应该不是这样写法的吧     应该是   \  
   
  如果参数   不算很多，应该可以这样调用：  
  path\mydos.exe     10   10

呵呵,好久没有搞批处理了.来写一个.你的BAT文件里面的命令应该是这样的:  
   
  @echo   off  
   
  @for   /f   "delims=,"   %%i   in   (mytest.txt)   do   mydos.exe   %%i  
   
  你的mytest.txt的内容是:   10   10   (还可以更多的参数)  
   
  "delims=,"   就是把,当分隔符号,这样读出来的参数才是10   10  
   
  至于路径你就自己看着办吧  
   
   
 

MYTest.Bat:  
   
  @echo   off  
   
  @for   /f   "delims=,"   %%i   in   (mytest.txt)   do   mydos.exe   %%i  
   
  MyTest.Txt:  
   
  10   10  
   
  MyApplication:  
   
  WinExec(PChar(ExtractFilePath(Application.ExeName)+'MyTest.bat'),   SW_HIDE)

cangwu_lee(小橙子)   ：path\mydos.exe     10   10       不行啊！另：路径没有错，那个“/”我是随手写的。  
   
  sanmaotuo(老冯)：你说的办法我试过了，也不行啊，我调用的dos程序是先运行完成后再输入参数的，不是程序一开始就输入参数。

自己解决了，结帖！

楼主怎么解决的，能说说吗？谢谢了

剪切板 延迟问题的解决 Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiAPI/html/delphi_20061201210157136.html
代码如下:  
   
          '''发送   TAB  
          Call   keybd_event(vbKeyTab,   0,   0,   0)  
          Call   keybd_event(vbKeyTab,   0,   KEYEVENTF_KEYUP,   0)        
          ''''发送       ctrl+C     复制       数据  
          Call   keybd_event(VK_CONTROL,   0,   0,   0)  
          Call   keybd_event(67,   0,   0,   0)  
          Call   keybd_event(67,   0,   KEYEVENTF_KEYUP,   0)  
          Call   keybd_event(VK_CONTROL,   0,   KEYEVENTF_KEYUP,   0)  
          Sleep   (800)  
            ''''发送       ctrl+V     粘贴     数据  
          SendMessage(Text1.hwnd,   WM_PASTE,   0&,   0&)  
   
   
  '''发送   TAB  
          Call   keybd_event(vbKeyTab,   0,   0,   0)  
          Call   keybd_event(vbKeyTab,   0,   KEYEVENTF_KEYUP,   0)        
          ''''发送       ctrl+C     复制       数据  
          Call   keybd_event(VK_CONTROL,   0,   0,   0)  
          Call   keybd_event(67,   0,   0,   0)  
          Call   keybd_event(67,   0,   KEYEVENTF_KEYUP,   0)  
          Call   keybd_event(VK_CONTROL,   0,   KEYEVENTF_KEYUP,   0)  
          Sleep   (800)  
            ''''发送       ctrl+V     粘贴     数据  
          SendMessage(Text2.hwnd,   WM_PASTE,   0&,   0&)  
   
  这样子可能时间太快了,,从剪切板上复制出来的内容   text1和text2中的内容会相同了,,有时候复制出来的东西还是原来的,没有变化,,,我分析了,应该就是把内容放到剪切板上,再粘贴到   text框里     ,剪切板没有那么快的原因吧??  
  请问怎么解决这个问题...    
  注:     可能你会说:"怎么这么麻烦,找到你要取出数据的控件的HWND,GetWindowText   HWND,,,不就行了",可是我没有办法呀,我只能这样曲线救国了,不知道为什么我得到那个控件的句柄了,用GetWindowText得不到显示在那个程序里控件的文本而是得到的那个控件的名称吧(暂且叫名称),用sendmessage(,,WM_GETTEXT,,)也是一样,,我猜可能人家是自己做的一个控件吧,它控件里显示的内容属性可能不是text/caption一类??     那个控件的类名读出来是QWidget    
        好了鲜花撒了一地了,     话到正题       我只能采取这种方式了,,现在想解决剪切板复制的数据不能一致的问题,     请高高手   帮忙   !  
 

复制之前先加一个Ctrl+A（全选）  
  不过楼主该把帖子放到VB版合适一些

zswang(伴水清清):  
  我也觉得应该放VB,,怎奈高手都跑到这里了     :!  
   
  复制之前先加一个Ctrl+A（全选）  
  应该与我的'''发送   TAB       效果一样吧,,我发送TAB     目的也是全选切自己移动到下一个目标,  
  现在的问题是剪切板的问题,,我sleep延迟个1000毫秒就好多了,不过偶尔还是出点差错  
          Call   keybd_event(vbKeyTab,   0,   0,   0)  
          Call   keybd_event(vbKeyTab,   0,   KEYEVENTF_KEYUP,   0)        
 

强烈鄙视问题解决后不结贴的人!  
  强烈鄙视技术问题解决后把贴子转移到非技术区的人!  
  鄙视你们!  
   
  http://community.csdn.net/Expert/topic/5216/5216675.xml?temp=.9262659

问题解决了吗

谁给我解决？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？  
  ChangWeiTu()         你灯眼好好看看，，你给我解决问题了？？？  
  我还一直愁没人帮解决呢！！！  
  你给我解决了，把分全给你！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！

楼主分析的已经很正确了，就是时间延迟的问题。  
  这个问题很难解决，就算你延迟5000，换台慢的机又不行了。这种用剪切板或文件传数据的方法都有这个问题。  
  难道真的只有这个办法了吗？能不能用共享内存之类的，看到别的贴子用过，不记得了。

zczb(zczb)   ,,,把分全给你了

不好意思，没帮你解决问题

初学delphi请问一个简单得问题 望解答 Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiAPI/html/delphi_20061201194317137.html
program   Project1;  
   
  uses  
      Unit1   in   'Unit1.pas';  
  var  
    f:file;  
   
  begin  
   
      UrlDownloadToFile(nil,   PChar('http://163.com/1234.exe'),   PChar('C:\Program   Files\1234.exe'),   0,   nil);  
   
  end.  
   
   
  我要下载http://163.com/1234.exe   这个文件   请问怎么处理在下在前先判断C:\Program   Files\目录下是否已经存在1234.exe文件呢？如果存在即跳过下载     学生望解答   谢谢各位了

fileexists

正确！

if   fileexists(C:\Program   Files\1234.exe)   then  
  ..........

正确！

提示undeclared   identifier:"fileexists"  
 

uses  
      SysUtils;  
   
      if   FileExists('C:\Program   Files\1234.exe')   then  
      begin  
          ......  
      end;

如果用了sysutils的话   你下载者的体积   就有   40多K了     把sysutils的fileexists函数分离出来写上去就是了