【源码】自动设置系统日期格式

tmtony

1. 
   
2. '===============================================================================-----天鸣科技--->>>>>>>>
   
3. '-函数名称:         gt_ChkDateFormat
   
4. '-功能描述:         自动设置系统日期格式
   
5. '-输入参数:         参数1:rblnSetDate Long 设置日期,如果为否则只是查看日期格式是否正确而不作设置
   
6. '-
   
7. '-返回参数:         Boolean 是否成功
   
8. '-使用示例:         rblnSetDate True
   
9. '-相关调用:
   
10. '-使用注意:
    
11. '-兼 容 性:         97,2000,XP,2003 compatible
    
12. '-参考资料:         网上资料
    
13. '-作    者:         王宇虹  修改：王宇虹
    
14. '-创建日期;         2002-08-26  更新日期: 2002-08-28 ,2006-10-15
    
15. '-图    解:
    
16. '===============================================================================--<>>>>>
    
17. 
    
18. Private Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long
    
19. 
    
20. Private Declare Function SetLocaleInfo Lib "kernel32" Alias "SetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String) As Boolean
    
21. 
    
22. Private Const LOCALE_SLONGDATE = &H20
    
23. 
    
24. Private Const LOCALE_SSHORTDATE = &H1F
    
25. 
    
26. Private Const LOCALE_SDATE = &H1D
    
27. 
    
28. Private Const LOCALE_STIME = &H1E
    
29. 
    
30. Public Function gt_ChkDateFormat(Optional rblnSetDate As Boolean = False) As Boolean
    
31. Dim lngLocale   As Long
    
32.     If Len(Date) <> 10 Or Mid(Date, 5, 1) <> "/" Then
    
33.       
    
34.      
    
35.       If rblnSetDate Then
    
36.       
    
37. 
    
38. 
    
39.             lngLocale = GetSystemDefaultLCID()
    
40.         
    
41.             'If lngLocale = 2052 Then  '判断繁体 简体等
    
42.                SetLocaleInfo lngLocale, LOCALE_SSHORTDATE, "yyyy-MM-dd"
    
43.                SetLocaleInfo lngLocale, LOCALE_SDATE, "/"
    
44.             ' End If
    
45.             gt_ChkDateFormat = True
    
46.             gt_MessageBox "日期格式不对,系统自动将 控制台-->地区选项(区域设置) 中日期的格式修改为:YYYY/MM/DD"
    
47.       Else
    
48.        gt_ChkDateFormat = False
    
49.        gt_MessageBox "日期格式不对,请在 控制台-->地区选项(区域设置) 中修改日期的格式为:YYYY/MM/DD"
    
50.        DoCmd.Quit
    
51.       End If
    
52.     Else
    
53.    
    
54.       If Len(Format(#1/1/2006#, "Short Date")) <> 10 Then
    
55.          
    
56.          If rblnSetDate Then
    
57.             lngLocale = GetSystemDefaultLCID()
    
58.                SetLocaleInfo lngLocale, LOCALE_SSHORTDATE, "yyyy-MM-dd"
    
59.                SetLocaleInfo lngLocale, LOCALE_SDATE, "/"
    
60. 
    
61.             gt_ChkDateFormat = True
    
62.             gt_MessageBox "日期格式不对,系统自动将 控制台-->地区选项(区域设置) 中日期的格式修改为:YYYY/MM/DD"
    
63.            
    
64.          Else
    
65.            gt_MessageBox "日期格式不对,请在 控制台-->地区选项(区域设置) 中修改日期的格式为:YYYY/MM/DD"
    
66.            gt_ChkDateFormat = False
    
67.            DoCmd.Quit
    
68.          End If
    
69.       Else
    
70.         gt_ChkDateFormat = True
    
71.       End If
    
72.     End If
    
73.   
    
74. End Function
    

复制代码

xuwenning

老大
好久没放源码了
支持
谢谢分享，收藏了

tmtony

呵呵，是啊，杂事比较多，很少有时间整理。

t小宝

老大的电脑可是个宝库呀，多花时间整理整理~~

roych

t小宝 发表于 2011-10-12 13:47
老大的电脑可是个宝库呀，多花时间整理整理~~

整理好帖些上来秀下嘛，roy期待中……

atscj

什么好东东让我仔细瞧瞧?