电脑城发现产品

电脑难有新概念,今年的双核明年?

但是周边产品开始丰富,如psp 等 (难见国产产品,说不定这是产业方向);存储设备面临手机的挑战危机,手机功能现在已经成了小型电脑;看见3400的gps汽车导航仪,感觉这个价格太高,仅有上海底图.(如果在武汉,如果普通家庭买5万左右的汽车,相信1千左右支持全国省会城市的这个产品是很有市场).可能关键是底图,软件硬件都很成熟.
Public Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long

Public Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long) As Long

Public Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

Public Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
ByVal x As Long, ByVal y As Long, _
ByVal cx As Long, ByVal cy As Long, _
ByVal wFlags As Long) As Long

Public Const LVM_FIRST = &H1000
Public Const LVM_SETEXTENDEDLISTVIEWSTYLE = LVM_FIRST + 54
Public Const LVM_GETEXTENDEDLISTVIEWSTYLE = LVM_FIRST + 55
Public Const LVM_GETHEADER = (LVM_FIRST + 31)

Public Const LVS_EX_FULLROWSELECT = &H20
Public Const LVS_EX_GRIDLINES = &H1
Public Const LVS_EX_TRACKSELECT = &H8
Public Const HDS_BUTTONS = &H2
Public Const GWL_STYLE = (-16)

Const SWP_DRAWFRAME = &H20
Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1
Const SWP_NOZORDER = &H4
Public Const SWP_FLAGS = SWP_NOZORDER Or SWP_NOSIZE Or SWP_NOMOVE Or SWP_DRAWFRAME

Public Const IDCANCEL = 0
Public Const IDOK = 1

'Processes state change to a checkbox of the node
Public Sub ProcessStateChange(nodeCurrent As Node)

Dim currImage
currImage = nodeCurrent.Image
'If box is notchecked or partchecked, then make it checked
If nodeCurrent.Image = 4 Then
nodeCurrent.Image = 2
nodeCurrent.SelectedImage = 2
ElseIf nodeCurrent.Image = 2 Then
nodeCurrent.Image = 4
nodeCurrent.SelectedImage = 4
End If

'Update list view for current node
'CheckListView nodeCurrent
'UpdateListView nodeCurrent
End Sub

Public Sub ProcessStateChangeLV(ListItemCurrent As ListItem)
'If box is notchecked then make it checked
If ListItemCurrent.Icon = 2 Then Exit Sub

If ListItemCurrent.Icon = 3 Then
ListItemCurrent.Icon = 1
ListItemCurrent.SmallIcon = 1
Else
'If checkbox is checked right now, then make it notchecked
ListItemCurrent.Icon = 3
ListItemCurrent.SmallIcon = 3
End If
End Sub

Public colAddFiles As New Collection

'n_whichProject = 0, it is for ICS, = 1 , it is for IIPstr_lang
Public Function DealwithPath(ByVal path As String, ByVal str_lang As String, n_ifSearch As Integer, n_whichProject As Integer) As String

DealwithPath = path
If DealwithPath = "" Then Exit Function

DealwithPath = Replace(DealwithPath & "", "", "")
' MsgBox (DealwithPath)

If n_whichProject = 0 Then
Dim PosSite, PosSupport, PosDesign As Integer
Dim i_langPos As Integer
PosSite = InStr(1, LCase(DealwithPath), LCase("sitessupport"), vbTextCompare)
If PosSite <= 0 Then PosSupport = InStr(1, LCase(DealwithPath), LCase("support"), vbTextCompare)
PosDesign = InStr(1, LCase(DealwithPath), LCase("design"), vbTextCompare)

If PosSite <= 0 And PosSupport <= 0 And PosDesign <= 0 Then
If n_ifSearch = 0 Then MsgBox ("The select folder '" & Trim(path) & "' does not match the ICS Porject folder structure!")
DealwithPath = ""
Exit Function
End If

If PosSite > 0 Then DealwithPath = Mid(DealwithPath, PosSite)
If PosSupport > 0 Then DealwithPath = Mid(DealwithPath, PosSupport)
If PosSite > 0 Or PosSupport > 0 Then DealwithPath = RemoveLangFromPath(DealwithPath, 0)

If PosDesign > 0 Then
DealwithPath = Mid(DealwithPath, PosDesign)
DealwithPath = RemoveLangFromPath(DealwithPath, 1)
End If
Else
Dim posTrack As Integer

posTrack = InStr(1, LCase(DealwithPath), LCase("track2"), vbTextCompare)
If posTrack <= 0 And InStr(1, LCase(DealwithPath), LCase("track1"), vbTextCompare) <= 0 Then
If n_ifSearch = 0 Then MsgBox ("The select folder '" & Trim(path) & "' does not match the IIP Project folder structure!")
DealwithPath = ""
Exit Function
End If
If posTrack <= 0 And InStr(1, LCase(DealwithPath), LCase("track1"), vbTextCompare) > 0 Then
posTrack = InStr(1, LCase(DealwithPath), LCase("track1"), vbTextCompare)
End If
DealwithPath = Mid(DealwithPath, posTrack)
DealwithPath = RemoveLangFromPath(DealwithPath, 0)
DealwithPath = RemoveAreaFromPath(DealwithPath)
End If

End Function

Public Function RemoveLangFromPath(ByVal str_path As String, n_ifDesign As Integer) As String
On Error Resume Next

str_path = Replace(str_path & "", "", "")
Dim arrLang(18) As String
Dim i, i_langPos As Integer
Dim str_lang As String
RemoveLangFromPath = Trim(str_path)
If n_ifDesign = 0 Then
arrLang(0) = "cn"
arrLang(1) = "kr"
arrLang(2) = "pt"
arrLang(3) = "sp"
arrLang(4) = "tw"
arrLang(5) = "ru"
arrLang(6) = "it"
arrLang(7) = "de"
arrLang(8) = "fr"
arrLang(9) = "es"
arrLang(10) = "jp"
arrLang(11) = "vi"
arrLang(12) = "th"
arrLang(13) = "pl"
arrLang(14) = "ar"
arrLang(15) = "cs"
arrLang(16) = "hu"
arrLang(17) = "tr"
Else
arrLang(0) = "langscn"
arrLang(1) = "langskr"
arrLang(2) = "langspt"
arrLang(3) = "langssp"
arrLang(4) = "langstw"
arrLang(5) = "langsru"
arrLang(6) = "langsit"
arrLang(7) = "langsde"
arrLang(8) = "langsfr"
arrLang(9) = "langses"
arrLang(10) = "langsjp"
arrLang(11) = "langsvi"
arrLang(12) = "langsth"
arrLang(13) = "langspl"
arrLang(14) = "langsar"
arrLang(15) = "langscs"
arrLang(16) = "langshu"
arrLang(17) = "langstr"
End If

For i = 0 To 17
str_lang = arrLang(i)
i_langPos = InStr(1, LCase(str_path), LCase(str_lang), vbTextCompare)
If i_langPos > 0 Then

RemoveLangFromPath = Mid(str_path, 1, i_langPos - 1) & Mid(str_path, i_langPos + Len(str_lang) - 1)
Exit Function
End If
Next

End Function

Public Function RemoveAreaFromPath(ByVal str_path As String) As String
On Error Resume Next

str_path = Replace(str_path & "", "", "")
Dim arrArea(4) As String
Dim i, i_areaPos As Integer
Dim str_lang As String
RemoveAreaFromPath = Trim(str_path)

arrArea(0) = "apac"
arrArea(1) = "emea"
arrArea(2) = "lar"
arrArea(3) = "ijkk"
For i = 0 To 3
str_area = arrArea(i)
i_areaPos = InStr(1, LCase(str_path), LCase(str_area), vbTextCompare)
If i_areaPos > 0 Then
RemoveAreaFromPath = Mid(str_path, 1, i_areaPos - 1) & Mid(str_path, i_areaPos + Len(str_area) - 1)
Exit Function
End If
Next
End Function

Public Function ifFileIsSearchInc(ByVal str_file As String) As Integer
ifFileIsSearchInc = -1
Dim str_fileName As String
Dim i_Pos As Integer
str_fileName = Trim(str_file)
i_Pos = InStr(1, LCase(str_fileName), LCase(".inc"), vbTextCompare)
If i_Pos <= 0 Then
ifFileIsSearchInc = -1
Exit Function
End If
i_Pos = InStr(1, LCase(str_fileName), LCase("search"), vbTextCompare)
If i_Pos = 1 Then
ifFileIsSearchInc = 1
Exit Function
End If
End Function

Public Function GetLangFromPath(ByVal str_path As String) As String
On Error Resume Next

str_path = Replace(str_path, "/", "")
Dim arrLang(18) As String
Dim i, i_langPos As Integer
Dim str_lang As String
GetLangFromPath = ""
arrLang(0) = "cn"
arrLang(1) = "kr"
arrLang(2) = "pt"
arrLang(3) = "sp"
arrLang(4) = "tw"
arrLang(5) = "ru"
arrLang(6) = "it"
arrLang(7) = "de"
arrLang(8) = "fr"
arrLang(9) = "es"
arrLang(10) = "jp"
arrLang(11) = "vi"
arrLang(12) = "th"
arrLang(13) = "pl"
arrLang(14) = "ar"
arrLang(15) = "cs"
arrLang(16) = "hu"
arrLang(17) = "tr"

For i = 0 To 17
str_lang = "" & arrLang(i) & ""
i_langPos = InStr(1, LCase(str_path), LCase(str_lang), vbTextCompare)
If i_langPos > 0 Then
GetLangFromPath = LCase(arrLang(i))
Exit Function
End If
Next

End FunctionPublic gbl_DropCreateMode As Boolean
Public gbl_Folder As String
Public gbl_lang As String
Public gbl_cmdFlag As Boolean
Public Database As String
Public gbl_ICSFlag As Boolean
Public nProject As Integer ' IIP 1 ; ICS 0

Sub Main()
gbl_DropCreateMode = False
gbl_Folder = ""
gbl_lang = ""
Dim commandOptions As String
Dim iPos1, ipos2, ipos3, ipos4 As Integer
Dim para1, para2, para3 As String

commandOptions = Trim(command())
ipos3 = InStr(1, commandOptions, "|", vbTextCompare)
ipos4 = InStr(1, commandOptions, "IIP", vbTextCompare)
If ipos4 > 0 Then
Database = App.path & "ucdb_iip.mdb"
gbl_ICSFlag = False
nProject = 1 'added by wayne
Else
Database = App.path & "ucdb.mdb"
gbl_ICSFlag = True
nProject = 0 'added by wayne
End If

'___________________________
'Wangjunyong 2007-3-11
If commandOptions = "" Then
frm_selectproject.Show vbModal
If nProject = 0 Then
Database = App.path & "ucdb.mdb"
gbl_ICSFlag = True
Else
Database = App.path & "ucdb_iip.mdb"
gbl_ICSFlag = False
End If
End If
'____________________________


If ipos3 <= 0 Then
MDIForm1.Show
gbl_cmdFlag = False

Else

gbl_cmdFlag = True

iPos1 = InStr(1, commandOptions, "|", vbTextCompare)
If iPos1 <= 0 Then
MsgBox ("Error. Invalid command line options")
MDIForm1.Show
Exit Sub
End If
para1 = Trim(Mid(commandOptions, 1, iPos1 - 1))
ipos2 = InStr(iPos1 + 1, commandOptions, "|", vbTextCompare)
If ipos2 <= 0 Then
MsgBox ("Error. Invalid command line options")
MDIForm1.Show
Exit Sub
End If
para2 = Trim(Mid(commandOptions, iPos1 + 1, ipos2 - iPos1 - 1))
para3 = Trim(Mid(commandOptions, ipos2 + 1))

If iPos1 = 0 Or ipos2 = 0 Then
MsgBox ("Error. Invalid command line options")
MDIForm1.Show
Else
If para1 = 1 Then
gbl_DropCreateMode = False
Else
gbl_DropCreateMode = True
End If
gbl_Folder = Trim(para2)
gbl_lang = Trim(para3)
MDIForm1.Show
End If
End If


End Sub

Public Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Public Function UserName() As String
Const UNLEN = 256 ' Max user name length.
Dim user_name As String
Dim name_len As Long

user_name = Space$(UNLEN + 1)
name_len = Len(user_name)
If GetUserName(user_name, name_len) = 0 Then
UserName = ""
Else
UserName = Left$(user_name, name_len - 1)
End If
End FunctionPublic Function getXmlPath() As String

Dim FSO As New Scripting.FileSystemObject
Dim iniPath As String
getXmlPath = ""
iniPath = "D:ICSTools" & "FolderSelect.xml"
If FSO.FileExists(iniPath) Then
getXmlPath = iniPath
'ReadLangFromIni (IniPath)
Else
getXmlPath = "FolderSelect.xml"
'If FSO.FileExists(IniPath) Then
' ReadLangFromIni (IniPath)
'End If
End If

Set FSO = Nothing

End Function

Public Function GetLangList(ByVal xmlPath As String) As String
GetLangList = ""
'This is because we always need language setting.
Dim xmlDoc As New MSXML2.DOMDocument
Dim currNode As IXMLDOMNode
xmlDoc.async = False
xmlDoc.resolveExternals = False
xmlDoc.Load (xmlPath)
If (xmlDoc.parseError.errorCode <> 0) Then
Dim myErr
Set myErr = xmlDoc.parseError
MsgBox ("You have error " & myErr.reason & "-" & xmlPath)
Else
Set currNode = xmlDoc.documentElement.selectSingleNode("//Configuration/LOCALIZED_LANGUAGE_LIST_CMS")
GetLangList = currNode.Text
End If

End Function

Public Function ReadPathFromIni(ByVal xmlPath As String) As Integer

Dim xmlDoc As New MSXML2.DOMDocument
'Dim objNodeList As IXMLDOMNodeList
Dim currNode As IXMLDOMNode

Dim sDropNum As String
Dim sMemberName As String
Dim sLanguageName As String
'Dim sProjectName As String ' defined for get project name
Dim sTemp1 As String
Dim sTemp2 As String

'if file not exist, then exit

xmlDoc.async = False
xmlDoc.resolveExternals = False
xmlDoc.Load (xmlPath)
If (xmlDoc.parseError.errorCode <> 0) Then
Dim myErr
Set myErr = xmlDoc.parseError
Else
Set currNode = xmlDoc.documentElement.selectSingleNode("//Configuration/DropNum")
sDropNum = currNode.Text
Set currNode = xmlDoc.documentElement.selectSingleNode("//Configuration/LanguageName")
sLanguageName = currNode.Text
Set currNode = xmlDoc.documentElement.selectSingleNode("//Configuration/MemberName")
sMemberName = currNode.Text
'added by wayne for decide which project to run for post processing
' Set currNode = xmlDoc.documentElement.selectSingleNode("//Configuration/Category")
' sProjectName = currNode.Text

' If (sProjectName = "ICS") Then
' gbl_ICSFlag = True
' End If
' If (sProjectName = "IIP") Then
' gbl_ICSFlag = False
' End If

' If (sProjectName <> "ICS" And sProjectName <> "IIP") Then
' MsgBox ("Wrong project name, please check folderselect.xml")
' End If

If (gbl_ICSFlag <> False) Then
Set currNode = xmlDoc.documentElement.selectSingleNode("//Configuration/LOCALIZED_FILE_FOLDER")
'nProject = 0
'Database = App.path & "ucdb.mdb"
Else
Set currNode = xmlDoc.documentElement.selectSingleNode("//Configuration/IIPLOCALIZED_FILE_FOLDER")
'nProject = 1
'Database = App.path & "ucdb_iip.mdb"
End If

sTemp2 = currNode.Text
sTemp1 = Replace(sTemp2, "[MemberName]", sMemberName)
sTemp2 = sTemp1
sTemp1 = Replace(sTemp2, "[DropNum]", sDropNum)
sTemp2 = Replace(sTemp1 & "", "", "")
gbl_Folder = Replace(sTemp2, "[LanguageName]", sLanguageName)
gbl_lang = sLanguageName
'MsgBox xmlDoc.xml
End If
End Function

[@more@]

来自 “ ITPUB博客 ” ，链接：http://blog.itpub.net/91551/viewspace-982891/，如需转载，请注明出处，否则将追究法律责任。

转载于:http://blog.itpub.net/91551/viewspace-982891/