几个delphi例子

 
 

  
  一.设置开机启动时不在任务栏显示
 
 
 
 

  
  uses 
  
  Registry
  
  ;
 
 
 
 


 
 
 
 

  
  procedure 
  
  Tsystembd
  
  .
  
  FormCreate
  
  (
  
  Sender
  
  : 
  
  TObject
  
  )
  
  ;
 
 
 
 

  
  var
 
 
 
 

  
  reg
  
  :
  
  tRegistry
  
  ;
 
 
 
 

  
  begin
 
 
 
 

  
  //写注册表，使本程序能跟随操作系统一起启动
 
 
 
 

  
  reg
  
  :=
  
  tRegistry
  
  .
  
  Create
  
  ;
 
 
 
 

  
  try
 
 
 
 

  
  reg
  
  .
  
  RootKey
  
  :=
  
  HKEY_LOCAL_MACHINE
  
  ;
 
 
 
 

  
  if 
  
  reg
  
  .
  
  OpenKey
  
  (
  
  'SOFTWAREMicrosoftWindowsCurrentVersionRun'
  
  ,
  
  True
  
  ) 
  
  then
 
 
 
 

  
  if 
  
  reg
  
  .
  
  ReadString
  
  (
  
  'CSRSS'
  
  )
  
  <>
  
  application
  
  .
  
  ExeName 
  
  then
 
 
 
 

  
  reg
  
  .
  
  WriteString
  
  (
  
  'CSRSS'
  
  ,
  
  application
  
  .
  
  ExeName
  
  )
  
  ;
 
 
 
 

  
  finally
 
 
 
 

  
  reg
  
  .
  
  Free
  
  ;
 
 
 
 

  
  end
  
  ;
 
 
 
 

  
  end
  
  ;
 
 
 
 

  
  //不在任务栏显示
 
 
 
 

  
  1
  
  、找到工程文件
  
  (
  
  Project 
  
  -> 
  
  View 
  
  Source
  
  )
  
  ,
  
  找到如下代码部分
  
  :
 
 
 
 
 
  
  修改工程文件中的“
  
  Application
  
  .
  
  MainFormOnTaskbar 
  
  := 
  
  True
  
  ;
  
  ”为“
  
  Application
  
  .
  
  MainFormOnTaskbar 
  
  := 
  
  False
  
  ;
  
  ”
 
 
 
 

  
  2 
  
  在主窗体的 
  
  OnShow 
  
  事件中写下
 
 
 
 

  
  var
 
 
 
 
  
  
  Style
  
  : 
  
  Integer
  
  ;
 
 
 
 

  
  begin
 
 
 
 
  
  
  Style 
  
  := 
  
  GetWindowLong
  
  (
  
  Handle
  
  , 
  
  GWL_EXSTYLE
  
  )
  
  ;
 
 
 
 
  
  
  SetWindowLong
  
  (
  
  Handle
  
  , 
  
  GWL_EXSTYLE
  
  , 
  
  Style 
  
  and 
  
  (
  
  not 
  
  WS_EX_APPWINDOW
  
  ))
  
  ;
 
 
 
 
  
  
  ShowWindow
  
  (
  
  Application
  
  .
  
  Handle
  
  , 
  
  SW_HIDE
  
  )
  
  ;
 
 
 
 

  
  end
 
 
 
 

  
  3 
  
  把窗体的
  
  Visble
  
  属性设置成
  
  False
  
  ;
 
 
 
 

  
  

 
 
 
 

  
  二.DELPHI高精度计时方法,取毫秒级时间精度(方法一)：
  
  
   
   
 
    
    　　
    
    //取毫秒级时间精度(方法一)：
   
   
   
   

    
    　　
    
    var
   
   
   
   

    
    　　
    
    t1
    
    ,
    
    t2
    
    :
    
    int64
    
    ;
   
   
   
   

    
    　　
    
    r1
    
    :
    
    int64
    
    ;
   
   
   
   

    
    　　
    
    begin
   
   
   
   

    
    　　
    
    t1
    
    :=
    
    GetTickCount
    
    ;
    
    //获取开始计数 WINDOWS API
   
   
   
   

    
    　　
    
    sleep
    
    (
    
    1000
    
    )
    
    ;
    
    {do...}
    
    //执行要计时的代码
   
   
   
   

    
    　　
    
    t2
    
    :=
    
    GetTickCount
    
    ;
    
    //获取结束计数值
   
   
   
   

    
    　　
    
    r1
    
    :=
    
    t2
    
    -
    
    t1
    
    ;
    
    //取得计时时间，单位毫秒(ms)
   
   
   
   

    
    　　
    
    showmessage
    
    (
    
    inttostr
    
    (
    
    r1
    
    ))
    
    ;
   
   
   
   

    
    　　
    
    end
    
    ;
   
   
   
   
 
   
   
   
   
 
    
    　　
    
    //取毫秒级时间精度(方法二)：
   
   
   
   

    
    　　
    
    //use DateUtils;//引用DateUtils单位
   
   
   
   

    
    　　
    
    var
   
   
   
   

    
    　　
    
    t1
    
    ,
    
    t2
    
    :
    
    tdatetime
    
    ;
   
   
   
   

    
    　　
    
    r1
    
    :
    
    int64
    
    ;
   
   
   
   

    
    　　
    
    begin
   
   
   
   

    
    　　
    
    t1
    
    :=
    
    now
    
    ()
    
    ;
    
    //获取开始计时时间
   
   
   
   

    
    　　
    
    sleep
    
    (
    
    1000
    
    )
    
    ;
    
    {do...}
    
    //执行要计时的代码
   
   
   
   

    
    　　
    
    t2
    
    :=
    
    now
    
    ()
    
    ;
    
    //获取结束计时时间
   
   
   
   

    
    　　
    
    r1
    
    :=
    
    SecondsBetween
    
    (
    
    t2
    
    ,
    
    t1
    
    )
    
    ;
    
    //取得计时时间，单位秒(s)
   
   
   
   

    
    　　
    
    r1
    
    :=
    
    MilliSecondsBetween
    
    (
    
    t2
    
    ,
    
    t1
    
    )
    
    ;
    
    //取得计时时间，单位毫秒(ms)
   
   
   
   

    
    　　
    
    showmessage
    
    (
    
    inttostr
    
    (
    
    r1
    
    ))
    
    ;
   
   
   
   

    
    　　
    
    end
    
    ;
   
   
   
   

    
    　　
    
    //注：以上两种方式经本人测试好像只能产生0.01秒的计时精度
   
   
   
   

    
    　　
    
    //取系统级时间精度：
   
   
   
   

    
    　　
    
    var
   
   
   
   

    
    　　
    
    c1
    
    :
    
    int64
    
    ;
   
   
   
   

    
    　　
    
    t1
    
    ,
    
    t2
    
    :
    
    int64
    
    ;
   
   
   
   

    
    　　
    
    r1
    
    :
    
    double
    
    ;
   
   
   
   

    
    　　
    
    begin
   
   
   
   

    
    　　
    
    QueryPerformanceFrequency
    
    (
    
    c1
    
    )
    
    ;
    
    //WINDOWS API 返回计数频率(Intel86:1193180)(获得系统的高性能频率计数器在一毫秒内的震动次数)
   
   
   
   

    
    　　
    
    QueryPerformanceCounter
    
    (
    
    t1
    
    )
    
    ;
    
    //WINDOWS API 获取开始计数值
   
   
   
   

    
    　　
    
    sleep
    
    (
    
    1000
    
    )
    
    ;
    
    {do...}
    
    //执行要计时的代码
   
   
   
   

    
    　　
    
    QueryPerformanceCounter
    
    (
    
    t2
    
    )
    
    ;
    
    //获取结束计数值
   
   
   
   

    
    　　
    
    r1
    
    :=
    
    (
    
    t2
    
    -
    
    t1
    
    )
    
    /
    
    c1
    
    ;
    
    //取得计时时间，单位秒(s)
   
   
   
   

    
    　　
    
    r1
    
    :=
    
    (
    
    t2
    
    -
    
    t1
    
    )
    
    /
    
    c1
    
    *
    
    1000
    
    ;
    
    //取得计时时间，单位毫秒(ms)
   
   
   
   

    
    　　
    
    r1
    
    :=
    
    (
    
    t2
    
    -
    
    t1
    
    )
    
    /
    
    c1
    
    *
    
    1000000
    
    ;
    
    //取得计时时间，单位微秒
   
   
   
   

    
    　　
    
    showmessage
    
    (
    
    floattostr
    
    (
    
    r1
    
    ))
    
    ;
   
   
   
   

    
    　　
    
    end
    
    ;
   
   
   
   

    
    

   
   
   
   

    
    三.TStringList的用法
   
   
   
   

    
    
    
    
     
     

      
      var 
     
     
     
     

      
      sl
      
      : 
      
      TStringList
      
      ; 
     
     
     
     

      
      str
      
      : 
      
      string
      
      ; 
     
     
     
     

      
      i
      
      : 
      
      Integer
      
      ; 
     
     
     
     

      
      begin 
     
     
     
     

      
      str 
      
      := 
      
      'aa,b b,cc,dd'
      
      ; 
     
     
     
     

      
      sl 
      
      := 
      
      TStringList
      
      .
      
      Create
      
      ; 
     
     
     
     

      
      sl
      
      .
      
      Delimiter 
      
      := 
      
      ','
      
      ; 
     
     
     
     

      
      sl
      
      .
      
      DelimitedText 
      
      := 
      
      str
      
      ; 
     
     
     
     

      
      for 
      
      i 
      
      := 
      
      0 
      
      to 
      
      sl
      
      .
      
      Count 
      
      - 
      
      1 
      
      do 
     
     
     
     

      
      ShowMessage
      
      (
      
      sl
      
      [
      
      i
      
      ])
      
      ; 
     
     
     
     

      
      FreeAndNil
      
      (
      
      sl
      
      )
      
      ; 
     
     
     
     

      
      end
      
      ;
     
     
     
     

      
      这样写，对于有空格的字符会有
      
      BUG
      
      的
     
     
     
     


     
     
     
     

      
      可以采取下列做法：
     
     
     
     

      
      //uses IdStrings 
     
     
     
     

      
      var 
     
     
     
     

      
      sl
      
      : 
      
      TStringList
      
      ; 
     
     
     
     

      
      str
      
      : 
      
      string
      
      ; 
     
     
     
     

      
      i
      
      : 
      
      Integer
      
      ; 
     
     
     
     

      
      begin 
     
     
     
     

      
      str 
      
      := 
      
      'aa,b b,cc,dd'
      
      ; 
     
     
     
     

      
      sl 
      
      := 
      
      TStringList
      
      .
      
      Create
      
      ; 
     
     
     
     

      
      SplitColumns
      
      (
      
      str
      
      , 
      
      sl
      
      , 
      
      ','
      
      )
      
      ;
      
      //该函数没有上述的BUG 
     
     
     
     

      
      for 
      
      i 
      
      := 
      
      0 
      
      to 
      
      sl
      
      .
      
      Count 
      
      - 
      
      1 
      
      do 
     
     
     
     

      
      ShowMessage
      
      (
      
      sl
      
      [
      
      i
      
      ])
      
      ; 
     
     
     
     

      
      FreeAndNil
      
      (
      
      sl
      
      )
      
      ; 
     
     
     
     

      
      end
      
      ;
     
     
     
     

      
      

     
     
     
     

      
      四.Delphi实现重启计算机
     
     
     
     

      
      
       
       

        
        procedure 
        
        TForm1
        
        .
        
        RebootSystem
        
        ;
       
       
       
       

        
        var
       
       
       
       
  
        
        osVerInfo
        
        : 
        
        TOSVersionInfo
        
        ;
       
       
       
       
  
        
        rl
        
        : 
        
        Cardinal
        
        ;
       
       
       
       
  
        
        hToken
        
        : 
        
        Cardinal
        
        ;
       
       
       
       
  
        
        tkp
        
        : 
        
        TOKEN_PRIVILEGES
        
        ;
       
       
       
       

        
        begin
       
       
       
       
  
        
        if 
        
        OpenProcessToken
        
        (
        
        GetCurrentProcess
        
        ()
        
        , 
        
        TOKEN_ADJUST_PRIVILEGES 
        
        or
       
       
       
       
    
        
        TOKEN_QUERY
        
        , 
        
        hToken
        
        ) 
        
        then
       
       
       
       
  
        
        begin
       
       
       
       
    
        
        osVerInfo
        
        .
        
        dwOSVersionInfoSize 
        
        := 
        
        SizeOf
        
        (
        
        TOSVersionInfo
        
        )
        
        ;
       
       
       
       
    
        
        if 
        
        GetVersionEx
        
        (
        
        osVerInfo
        
        ) 
        
        then
       
       
       
       
      
        
        case 
        
        osVerInfo
        
        .
        
        dwPlatformId 
        
        of
       
       
       
       
        
        
        VER_PLATFORM_WIN32_NT
        
        : 
        
        // Windows NT/2000/XP
       
       
       
       
          
        
        begin
       
       
       
       
            
        
        OpenProcessToken
        
        (
        
        GetCurrentProcess
        
        , 
        
        TOKEN_ADJUST_PRIVILEGES 
        
        or
       
       
       
       
              
        
        TOKEN_QUERY
        
        , 
        
        hToken
        
        )
        
        ;
       
       
       
       
            
        
        if 
        
        LookupPrivilegeValue
        
        (
        
        nil
        
        , 
        
        'SeShutdownPrivilege'
        
        ,
       
       
       
       
              
        
        tkp
        
        .
        
        Privileges
        
        [
        
        0
        
        ]
        
        .
        
        Luid
        
        ) 
        
        then
       
       
       
       
            
        
        begin
       
       
       
       
              
        
        tkp
        
        .
        
        Privileges
        
        [
        
        0
        
        ]
        
        .
        
        Attributes 
        
        := 
        
        SE_PRIVILEGE_ENABLED
        
        ;
       
       
       
       
              
        
        tkp
        
        .
        
        PrivilegeCount 
        
        := 
        
        1
        
        ;
       
       
       
       
              
        
        AdjustTokenPrivileges
        
        (
        
        hToken
        
        , 
        
        False
        
        , 
        
        tkp
        
        , 
        
        0
        
        , 
        
        nil
        
        , 
        
        rl
        
        )
        
        ;
       
       
       
       
            
        
        end
        
        ;
       
       
       
       
            
        
        // ExitWindowsEx(EWX_SHUTDOWN + EWX_FORCE + EWX_POWEROFF, 0);   //关闭计算机
       
       
       
       
            
        
        ExitWindowsEx
        
        (
        
        EWX_REBOOT
        
        , 
        
        $FFFF
        
        )
        
        ; 
        
        // 重启
       
       
       
       
          
        
        end
        
        ;
       
       
       
       
        
        
        VER_PLATFORM_WIN32_WINDOWS
        
        : 
        
        // Windows 95/98/98SE/Me
       
       
       
       
          
        
        begin
       
       
       
       
            
        
        // ExitWindowsEx(EWX_SHUTDOWN + EWX_FORCE + EWX_POWEROFF, 0);   //关闭计算机
       
       
       
       
            
        
        ExitWindowsEx
        
        (
        
        EWX_REBOOT
        
        , 
        
        $FFFF
        
        )
        
        ; 
        
        // 重启
       
       
       
       


       
       
       
       
          
        
        end
        
        ;
       
       
       
       
      
        
        end
        
        ;
       
       
       
       
  
        
        end
        
        ;
       
       
       
       

        
        end
        
        ;
       
       
       
       


       
       
       
       

        
        调用 
        
        ：
       
       
       
       

        
        procedure 
        
        TForm1
        
        .
        
        X1Click
        
        (
        
        Sender
        
        : 
        
        TObject
        
        )
        
        ;
       
       
       
       

        
        begin
       
       
       
       
  
        
        if 
        
        MessageBox
        
        (
        
        0
        
        , 
        
        '你要重启计算机吗？'
        
        , 
        
        '警告'
        
        , 
        
        MB_ICONQUESTION 
        
        or 
        
        MB_YESNO
        
        ) 
        
        = 
        
        idyes 
        
        then
       
       
       
       
  
        
        begin
       
       
       
       
    
        
        RebootSystem
        
        ;
       
       
       
       
  
        
        end
        
        ;
       
       
       
       
  
        
        application
        
        .
        
        Terminate
        
        ;
       
       
       
       

        
        end
        
        ;