'===============================================================
'
' dirHTML.exe v0.01
' to make only FoderDirectry HTML File List for WEB WWW using.
'
' Copy Right Miyama. 2025 May
'
' http://kazutomimiyama.sakura.net
' KazutomiMiytamaSub@gmail.com
'
'===============================================================
Option Explicit On
Imports System
Imports System.IO
Imports System.Text
Public Class Form1
Dim FSO = CreateObject("Scripting.FileSystemObject")
Dim Folder As Object = FSO.geTFolder(".\")
Dim WTS As StreamWriter
Dim ObjSJIS As Object = Encoding.GetEncoding("Shift_JIS")
Dim VacantCHR As String = VacantCHR
Dim EXEName = "dirHTML.exe"
Dim ApoBATName As String = "ApoPtosis.bat"
Dim ListmpHeaderTMName As String = "HTML$$$$.htm"
Private Sub GoBTN_Click(sender As Object, e As EventArgs) Handles GoBTN.Click
Dim FirstMSG As String =
"ファイルのダウンロードおよび実行は自己責任でお願いします。" +
vbCrLf +
"Please use on tmpHeadere each responsibility to DownLoad or Execute files."
Dim EscapeFlag As Boolean
Dim HS As String = ""
Dim TS As String = ""
'Dim tstS = InputBox("?")
'MessageBox.Show(Asc(tstS))
' " is 34
WTS = New StreamWriter(ListmpHeaderTMName, False, ObjSJIS)
With WTS
.WriteLine("")
.WriteLine(FirstMSG)
.WriteLine(VacantCHR)
Dim FilesCollection As Object = Folder.files
For Each FileOBJ In FilesCollection
EscapeFlag = False
Select Case FileOBJ.name
Case EXEName : EscapeFlag = True
Case ApoBATName : EscapeFlag = True
Case ListmpHeaderTMName : EscapeFlag = True
End Select
If EscapeFlag = False Then
.WriteLine(HS + FileOBJ.name +
FS + FileOBJ.name + TS)
.WriteLine(VacantCHR)
End If
Next
.WriteLine("")
.Close()
End With
MessageBox.Show("finished")
End Sub
Private Sub TXTHTMLtoSJISBTN_click(sender As Object, e As EventArgs) Handles TXTHTMLtoSJISBTN.Click
Dim BakFolderName As String = ".\bak"
Dim tmpHeader As String = "tmp"
Dim TargetFileName As String = VacantCHR
Dim BakFileName As String = VacantCHR
Dim RTS As StreamReader
Dim LineSTR As String
While FSO.fileexists(TargetFileName) = False
TargetFileName = InputBox("FileName ?")
End While
If FSO.folderexists(BakFolderName) = False Then
FSO.createfolder(BakFolderName)
End If
BakFileName = BakFolderName + "\" + TargetFileName
If FSO.fileexists(BakFileName) = True Then
MessageBox.Show(
" すでに一度オリジナルファイルがバックアップされています。" +
"変換事故の上書を防ぐため、これ以上の上書は出来ません。" +
"処理を続行するには、bakフォルダーのファイルを移動するか、" +
"別の名前に変更してください。" + vbCrLf +
" Already Once backup-ed. It is not permitted to over write. " +
"Please ReName the backup file in the bak folder to another name.")
Else
File.Copy(TargetFileName, BakFileName, False)
WTS = New StreamWriter(tmpHeader + TargetFileName, False, ObjSJIS)
RTS = New StreamReader(TargetFileName)
While RTS.EndOfStream = False
LineSTR = RTS.ReadLine
WTS.WriteLine(LineSTR)
End While
RTS.Close()
WTS.Close()
File.Delete(TargetFileName)
File.Copy(tmpHeader + TargetFileName, TargetFileName, True)
File.Delete(tmpHeader + TargetFileName)
MessageBox.Show("finished")
End If
End Sub
Private Sub ExitBTN_Click(sender As Object, e As EventArgs) Handles ExitBTN.Click
'File.Delete("test.exe")' no anable
'make apoptosis file
WTS = New StreamWriter(ApoBATName)
With WTS
.WriteLine("del " + EXEName)
.WriteLine("del " + ApoBATName)
.Close()
End With
Me.Close()
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
With Me
.Width = 400
.Height = 240
.Text = "dirHTML v0.01"
End With
With ExitBTN
.Left = 0
.Top = 0
.Width = 400
.Height = 40
.Text = "Exit &X"
.TabIndex = 2
End With
With TXTHTMLtoSJISBTN
.Left = 0
.Top = 40
.Width = 200 - 8
.Height = 200 - 40
.Text = "TXT to ShiftJIS &S"
.TabIndex = 1
End With
With GoBTN
.Left = 200 - 8
.Top = 40
.Width = 200 - 8
.Height = 200 - 40
.Text = "Go &G"
.TabIndex = 0
End With
End Sub
End Class
'===============================================================
' End of File.
'===============================================================