Monday, November 29, 2010

Pukiwiki Page name conversion in Excel VBA

This is to convert PukiWiki filename into converted text.
From: 536974654E6176696761746F72.txt
´╗┐To: SiteNavigator
-----
Function GetWikiName(strFileName As String, Optional strFr As String = "EUC-JP", Optional strTo As String = "Unicode") As String

Dim lngLen As Long
Dim lngIdx As Long
Dim strTranslated As String
Dim strTemp() As Byte

strTranslated = ""
lngLen = (Len(strFileName) - 4) / 2 - 1

ReDim strTemp(lngLen)
For lngIdx = 0 To lngLen
strTemp(lngIdx) = "&H" & Mid(strFileName, lngIdx * 2 + 1, 2)
DoEvents
Next

GetWikiName = Euc2Jis(strTemp, strFr, strTo)

End Function

Function Euc2Jis(ByRef src() As Byte, Optional strFrom = "EUC-JP", Optional strTo = "Unicode") As Byte()
Dim EUC As Object
Dim JIS As Object

Const adTypeBinary = 1
Const adTypeText = 2
Const adReadAll = -1
Const adCR = 13
Const adCRLF = -1
Const adLF = 10

Set EUC = CreateObject("ADODB.Stream")
Set JIS = CreateObject("ADODB.Stream")

EUC.Open
EUC.Type = adTypeBinary
EUC.Write src
EUC.Position = 0
EUC.Type = adTypeText
EUC.Charset = strFrom

JIS.Open
JIS.Type = adTypeText
JIS.Charset = strTo
JIS.LineSeparator = adCRLF

EUC.CopyTo JIS, adReadAll
EUC.Close
Set EUC = Nothing

JIS.Position = 0
JIS.Type = adTypeBinary

Euc2Jis = JIS.Read(adReadAll)

JIS.Close
Set JIS = Nothing

End Function

Sunday, January 08, 2006

FTP - Mass processing to put files

This snippet can be used for putting mass files on remote server via FTP. You specify Server name, User ID, Password, Remote directory, Local directory and files then the function will put files on the remote server. For declaration of the APIs, refer to the previous posts.


Public Function PutFiles(FtpSvr As String, UserID As String, _
Password As String, RemoteDirectory As String, _
LocalDirectory As String, LocalFiles As Collection) As Long
Dim iHandle As Long
Dim iFTP As Long
Dim lngRet As Long
Dim ErrText As String
Dim varUnit As Variant
PutFiles = vbOK
'Connection open
iHandle = InternetOpen(vbNullString, _
INTERNET_OPEN_TYPE_PRECONFIG, _
vbNullString, _
vbNullString, _
0&)
If iHandle = 0 Then PutFiles = vbCancel: GoTo GOEXIT ': Exit Function 'Error
'Connect to server
iFTP = InternetConnect(iHandle, _
FtpSvr, _
INTERNET_DEFAULT_FTP_PORT, _
UserID, _
Password, _
INTERNET_SERVICE_FTP, _
0&, _
0&)
If iFTP = 0 Then PutFiles = vbCancel: GoTo GOEXIT

'Put file to server. Can switch Ascii/Binary by changing the parameter below.
'Change directory on Local
ChDir LocalDirectory
'Change directory on Remote
lngRet = FtpSetCurrentDirectory(iFTP, RemoteDirectory)
If lngRet = 0 Then PutFiles = vbCancel ': Exit Function 'Error
'
For Each varUnit In LocalFiles
lngRet = FtpPutFile(iFTP, _
varUnit & vbNullChar, _
varUnit & vbNullChar, _
FTP_TRANSFER_TYPE_ASCII, _
0&)
DoEvents
Next

GOEXIT:
lngRet = InternetCloseHandle(iFTP)
lngRet = InternetCloseHandle(iHandle)
End Function

Saturday, January 07, 2006

FTP - List up files on remote server

Here is a code to create a list of the files on the remote server. The function ListUpFiles will create a collection of the file name that you have specified as a parameter. In addition to the FTPFindFirstFile and InternetFindNextFile, you will need the declaration of the functions like Open/Close. (Refer to the past posts for these functions.)


'Get first file
Public Declare Function FtpFindFirstFile Lib "wininet.dll" _
Alias "FtpFindFirstFileA" (ByVal hFtpSession As Long, _
ByVal lpszSearchFile As String, ByRef lpFindFileData As WIN32_FIND_DATA, _
ByVal dwFlags As Long, ByVal dwContent As Long) As Long

'Get next file
Public Declare Function InternetFindNextFile Lib "wininet.dll" _
Alias "InternetFindNextFileA" _
(ByVal hFind As Long, ByRef findFileData As WIN32_FIND_DATA) _
As Boolean

Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Public Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * 260
cAlternate As String * 14
End Type
...
Public Function ListUpFiles(FtpSvr As String, UserID As String, _
Password As String, RemoteDirectory As String) As Collection

Dim iHandle As Long
Dim iFTP As Long
Dim lngRet As Long
Dim ErrText As String
Dim varUnit As Variant
Dim w32File As WIN32_FIND_DATA
Dim strFile As String

Set ListUpFiles = New Collection

'Connection open
iHandle = InternetOpen(vbNullString, _
INTERNET_OPEN_TYPE_PRECONFIG, _
vbNullString, _
vbNullString, _
0&)
If iHandle = 0 Then GoTo GOEXIT: ' Exit Function 'Error

'Connect to server
iFTP = InternetConnect(iHandle, _
FtpSvr, _
INTERNET_DEFAULT_FTP_PORT, _
UserID, _
Password, _
INTERNET_SERVICE_FTP, _
0&, _
0&)
If iFTP = 0 Then GoTo GOEXIT

'Change directory on Remote
lngRet = FtpSetCurrentDirectory(iFTP, RemoteDirectory)
If lngRet = 0 Then GoTo GOEXIT ': Exit Function 'Error

'
lngRet = FtpFindFirstFile(iFTP, RemoteDirectory, _
w32File, 0, 0)
Do
If lngRet > 0 Then
strFile = Left(w32File.cFileName, _
InStr(w32File.cFileName, Chr(0)) - 1)
ListUpFiles.Add strFile
End If
DoEvents
Loop While InternetFindNextFile(lngRet, w32File) <> 0

GOEXIT:
lngRet = InternetCloseHandle(iFTP)
lngRet = InternetCloseHandle(iHandle)

End Function


You can use this with the code below.

Sub Temp()
Dim colTemp As Collection
Dim varUnit As Variant
Set colTemp = ListUpFiles("blue.client.jp", _
"UserID", "PassWord", "/")
For Each varUnit In colTemp
Debug.Print varUnit
Next
End Sub

Friday, January 06, 2006

Windows - Check window is maxmized

On the contrary to IsIconic API, you can check if the window is maxmized by IsZoomed API.


'Declare API
Public Declare Function IsZoomed Lib "USER32" _
(ByVal hWnd As Long) As Long

Sub Temp()
Dim lngReturn As Long
lngReturn = IsZoomed(Application.hWnd)
If lngReturn <> 0 Then
MsgBox "Window is maximized"
Else
MsgBox "Window is not maximized"
End If
End Sub

Thursday, January 05, 2006

Windows - Check window is minimized

This API - IsIconic - is for checking the window status. If it is minimized and iconized, the result is returned as 1.


'Decare API
Public Declare Function IsIconic Lib "USER32" _
(ByVal hWnd As Long) As Long

Private Sub Temp()
Dim lngResult As Long
lngResult = IsIconic(Application.hWnd)
If lngResult = 1 Then
MsgBox Application.Name & " is minimized"
Else
MsgBox Application.Name & " is not minimized"
End If
End Sub

Wednesday, January 04, 2006

Windows - Display About dialog

By declaring ShellAbout function, we can display "About" dialog in application. Here is an example of the code.


Public Declare Function ShellAbout Lib "SHELL32" _
Alias "ShellAboutA" _
(ByVal hWnd As Long, ByVal szApp As String, _
ByVal szOtherStuff As String, ByVal hIcon As Long) As Long

Sub Temp()
Dim lngRet As Long
lngRet = ShellAbout(Application.hWnd, "Sapass", vbCrLf & "Description", 0)
End Sub

Sunday, December 04, 2005

Windows - Sleep

Sleep function makes the running process sleep for specified milli seconds.


Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub Temp()
MsgBox "Fall into sleep.."
Sleep 5000
MsgBox "Slept 5000 mm sec"
End Sub