Input TextArea and Output TextArea and Save To

前端未结
关注
 1  387
I\'ve written up a quick hta for quick actions via button: copy to clipboard, message boxes, and run specific files. Now I\'m trying figure out how to add:
2 textarea bo
相关标签:
1条回答
庸人自扰
2021-01-23 08:31
EDIT : 09/03/2015 Try something like that :
<html>
<Title>How to open and read the log file with HTA</Title>
<head>
<HTA:APPLICATION 
ICON="cmd.exe"
APPLICATIONNAME = "How to open and read the log file with HTA" 
BORDER="dialog"
BORDERSTYLE="complex"
WINDOWSTATE="maximize"
>
<style>
body{
background-color: Black;
}
</style>
</head>
<script type="text/Vbscript">
Option Explicit
Dim File,fso,oFile,objShell
Set fso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell") 
File = "C:\Test_" _
    & Month(Date) & "_" & Day(Date) & "_" & Year(Date) _
    & ".txt"
'***********************************************************
Sub LoadMyFile()
    txtBody.Value = LoadFile(File)
End Sub
'***********************************************************
Function LoadFile(File)
    On Error Resume Next
    Dim fso,F,ReadMe,strError
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set F = fso.OpenTextFile(File,1)
    If Err.Number <> 0  Then
        strError = "<center><b><font color=Red>The file "& File &" dosen't exists !</font></b></center>"
        myDiv.InnerHTML = strError
        Exit Function
    End If
    ReadMe = F.ReadAll
    LoadFile = ReadMe
End Function
'***********************************************************
Sub Clear()
    txtBody.Value = ""
    myDiv.InnerHTML = ""
    Txtarea.Value = ""
End Sub
'***********************************************************
Function LogOpen()
    Dim Ws,iReturn,strError
    Set ws = CreateObject("WScript.Shell")
    On Error Resume Next
    iReturn = Ws.Run(File,1,False)
    If Err.Number <> 0  Then
        strError = "<center><b><font color=Red>The file "& File &" dosen't exists !</font></b></center>"
        myDiv.InnerHTML = strError
        Exit Function
    End If
End Function
'***********************************************************
Sub Submitarea()
    Dim oFile,sTxtarea,Readfile,ReadAllTextFile,strError
    If Not fso.FileExists(File) Then
        Set oFile = fso.OpenTextFile(File,2,true)
        oFIle.write "The File "& File &" is created at " & FormatDateTime(now,vbLongTime)
        oFile.Close
    End If
    Set Readfile = fso.OpenTextFile(File,1)
    ReadAllTextFile = Readfile.ReadAll
    Set oFile = fso.OpenTextFile(File,2,true)
    sTxtarea = document.all("Txtarea").Value
    oFIle.Writeline
    oFIle.write ("Name ")
    oFIle.write FormatDateTime(now, 2)
    oFIle.write (" ")
    oFIle.write FormatDateTime(now,vbLongTime)
    'FormatDateTime(now, 4)
    oFIle.write (" - ")
    oFIle.Write sTxtarea & vbCrLf
    oFIle.WriteLine ReadAllTextFile
    myDiv.InnerHTML = "Your text has been added to "& File &""
    oFile.Close
    Call LoadMyFile()
End Sub
'***********************************************************
</script>
<body text="white">
<center><input type="button" name="Log" id="Start" value="  Load LogFile  " onclick="LoadMyFile()"><br><br>
<textarea id="txtBody" rows="15" cols="120"></textarea><br><br>
<input type="button" name="Log" id="Start" value="  Open LogFile with Notepad  " onclick="LogOpen()">
<input type="button" value="  Clear  " onclick="Clear()"></center>
<Div id="myDiv"></Div>
<br><br>
<TEXTAREA style="
Height:193;
Width:100%;
font-Size:12;
color:#000000;
background-color:#ffffe7;
font-weight:normal;
font-family:MS Sans Serif" 
TITLE="" 
ID="Txtarea" NAME="Txtarea" TABORDER="2" WRAP="PHYSICAL">The contents of this text area will be written to TextArea.txt when you click submit.</TEXTAREA><br><br>
<center><input type="button" value="Submit" onclick="Submitarea">
<input type="reset" value="Reset"></center>
</body>
</html>
0 讨论(0)