獲得internet 時間的問題?

來源:互聯網
上載者:User
獲得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.

分給我.

相關文章

聯繫我們

該頁面正文內容均來源於網絡整理,並不代表阿里雲官方的觀點,該頁面所提到的產品和服務也與阿里云無關,如果該頁面內容對您造成了困擾,歡迎寫郵件給我們,收到郵件我們將在5個工作日內處理。

如果您發現本社區中有涉嫌抄襲的內容,歡迎發送郵件至: info-contact@alibabacloud.com 進行舉報並提供相關證據,工作人員會在 5 個工作天內聯絡您,一經查實,本站將立刻刪除涉嫌侵權內容。

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.