I am maintaining a site that uses a HTML editor with an image upload feature. When you click upload it opens a popup that lists a path to every image in the folder. There are currently more than 7000 images in the folder.
The code is quite messy. It uses the Scripting.FileSystemObject to get an array of the files and then loops using a for each statement.A response.write is used to display each file's info and for some reason an issue is occurring if there's more than 4015 images in the folder. No error is occurring as such but it seems the function writing out the files just fails silently and the page stops rendering.
I am confused why it works when there's less than 4015 files. Could it be a memory issue ? I was expecting to receive an error of some sort.
Thanks for any info.
Below is the Response.Write being used for each file
Response.Write "<tr style='background:" & sColorResult & "'>" & VbCrLf & _
"<td><img src='images/"&sIcon&"'></td>" & VbCrLf & _
"<td valign=top width=100% ><u id=""idFile"&nIndex&""" style='cursor:pointer;' onclick=""selectFile(" & nIndex & ")"">" & oFile.name & "</u> <img style='cursor:pointer;' onclick=""downloadFile(" & nIndex & ")"" src='download.gif'></td>" & VbCrLf & _
"<td valign=top align=right nowrap>" & FormatNumber(oFile.size/1000,1) & " kb </td>" & VbCrLf & _
"<td valign=top nowrap onclick=""deleteFile(" & nIndex & ")""><u style='font-size:10px;cursor:pointer;color:crimson' " & sFolderAdmin & ">" & VbCrLf
if not bWriteFolderAdmin then
Response.Write "<script>document.write(getTxt('del'))</script>" & VbCrLf
end if
Response.Write "</u></td></tr>" & VbCrLf
Sounds like the issue here was the response buffer filling up. Either of these solutions should work:
Disable buffering by adding Response.Buffer = False as the first line of code.
Leave buffering enabled but call Response.Flush() at certain intervals to flush the buffer.
Related
A friend of mine asked me a favor, help him to install CK Editor into SnitzForum (yeah old I know). Since I am not into asp lang. I have a problem since after putting into the head the CDN code I have to put below the tag this code:
<script> CKEDITOR.replace( 'editor1' ); </script>
So this is the part where the textarea is into the file post.asp:
<%
end if
end if
Response.Write " </font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine & _
" </font></td>" & vbNewLine & _
" <td bgColor=""" & strPopUpTableColor & """><textarea cols=""" & intCols & """ name=""editor1"" rows=""" & intRows & """ wrap=""VIRTUAL"" onselect=""storeCaret(this);"" onclick=""storeCaret(this);"" onkeyup=""storeCaret(this);"" onchange=""storeCaret(this);"">" & Trim(CleanCode(TxtMsg)) & "</textarea><br /></td>" & vbNewLine & _
" </tr>" & vbNewLine
end if
select case strRqMethod
case "Reply", "ReplyQuote", "TopicQuote"
Response.Write " <script language=""JavaScript"" type=""text/javascript"">document.PostTopic.Message.focus();</script>" & vbNewLine
end select
How can I add that script? Thanks :)
Edited Code:
<!--#INCLUDE FILE="inc_smilies.asp" -->
<%
end if
end if
Response.Write " </font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine & _
" </font></td>" & vbNewLine & _
" <td bgColor=""" & strPopUpTableColor & """><textarea cols=""" & intCols & """ name=""Message"" rows=""" & intRows & """ wrap=""VIRTUAL"" onselect=""storeCaret(this);"" onclick=""storeCaret(this);"" onkeyup=""storeCaret(this);"" onchange=""storeCaret(this);"">" & Trim(CleanCode(TxtMsg)) & "</textarea><br /></td>" & vbNewLine & _
" </tr>" & vbNewLine
%>
<script>
tinymce.init({
selector: 'textarea',
toolbar_mode: 'floating',
});
</script>
<%
end if
select case strRqMethod
case "Reply", "ReplyQuote", "TopicQuote"
Response.Write " <script language=""JavaScript"" type=""text/javascript"">document.PostTopic.Message.focus();</script>" & vbNewLine
end select
Ok, so an working example with a text box could (would) be this:
<script src="https://cdn.ckeditor.com/4.16.2/standard/ckeditor.js"></script>
<div style="width:50%">
<asp:TextBox ID="TextBox1" runat="server" Height="304px" Width="617px"
TextMode="MultiLine"
ClientIDMode="Static"
></asp:TextBox>
</div>
<script>
CKEDITOR.replace('TextBox1');
</script>
And we now get this:
So, as noted, it probably better to hide/show the one div above, then trying to inject the above markup into the page. And the REASON why is that then in code behind, you want to be able to get the textbox by using
TextBox1.text
So, by placing a plane jane text box (TextBox1) on the form, then code behind can use that text box. If you inject the markup, then code behind will have a much more difficult time using that markup and using TextBox1.Text to get the results of the markup in that text box.
So I don't see the need to use "code" to inject the above. As I noted, perhaps you need to hide/show this?
Then add a "ID" to the div like this:
<div id="mycooleditor" runat="server" style="width:35%;display:none">
<asp:TextBox ID="TextBox1" runat="server" Height="304px" Width="617px"
TextMode="MultiLine"
ClientIDMode="Static"
></asp:TextBox>
</div>
Now, in code behind, to display the editor, we can go:
mycooleditor.Style.Add("display", "normal")
So, unless you make a REALLY good case as to why we using code to inject the html into the web page as opposed just dropping in the markup as per above without any code (and saving world poverty's at the same time), then I see no reason to spend the time + effort writing code that does the same thing?
You can write code to inject, but I see no reason why when you can just drop in the markup anyway???
Overworked. Put the tinymce files in their own folder (titled "tinyMCE") below the forum root. In the file "inc_header.asp", look for this code (appx lines 240-242):
'## START - REMOVAL, MODIFICATION OR CIRCUMVENTING THIS CODE WILL VIOLATE THE SNITZ FORUMS 2000 LICENSE AGREEMENT
Response.Write "<meta name=""copyright"" content=""This Forum code is Copyright (C) 2000-09 Michael Anderson, Pierre Gorissen, Huw Reddick and Richard Kinser, Non-Forum Related code is Copyright (C) " & strCopyright & """>" & vbNewline
'## END - REMOVAL, MODIFICATION OR CIRCUMVENTING THIS CODE WILL VIOLATE THE SNITZ FORUMS 2000 LICENSE AGREEMENT
Below that bit, insert this:
If strScriptName = "post.asp" Then
Response.Write " <script src=""./tinyMCE/tinymce.js""></script>" & vbNewLine & _
" <script language=""Javascript"">tinymce.init ({" & vbNewLine & _
" selector:'textarea'," & vbNewLine & _
" theme:'modern'," & vbNewLine & _
" browser_spellcheck:'true'," & vbNewLine & _
" plugins:['advlist anchor autolink charmap code contextmenu directionality emoticons fullscreen hr insertdatetime image link lists media nonbreaking paste print preview pagebreak save searchreplace table template textcolor visualblocks visualchars wordcount']," & vbNewLine & _
" content_css:'css/combined-min.css'," & vbNewLine & _
" toolbar:'undo redo | styleselect | bold italic | alignleft aligncenter alignright alignjustify | bullist numlist outdent indent | link image | preview media fullpage | forecolor backcolor emoticons'," & vbNewLine & _
" });</script>" & vbNewLine
End If
That will take over all instances of the text area in "post.asp". If you want to use it throughout the forum for text areas, remove the If/End If lines.
I am developing a sms bulk sender using smart bro plug in modem.
when I am sending, it gives an error of Message sending failed. This is my code.
With Serialport1
.Write("AT" & vbCrLf)
Threading.Thread.Sleep(1000)
.Write(AT+CMGF=1" & vbCrLf)
Threading.Thread.Sleep(1000)
.Write("AT+CMGS=1" & Chr(34) & txtNumber.Text & Chr(34) & vbCrLf)
.Write(RichTextBox.text & Chr(26))
Threading.Thread.Sleep(1000)
MsgBox(rcvdata.ToString)
When I use Putty to check the connection of the modem; these are the results
AT
ok
AT+CMGF=1
Ok
'when I tried
AT+CMGS="+639970850099"
Error
Requesting someone who can help me.
Thank you and keep safe.
.Write("AT+CMGS=1" & Chr(34) & txtNumber.Text & Chr(34) & vbCrLf)
No 1 sa AT+CMGS=
Should be
.Write("AT+CMGS=" & Chr(34) & txtNumber.Text & Chr(34) & vbCrLf)
I want to assign below mentioned xml values to a string like this
Dim test As String
test = ... ?
Where the XML should contain:
<RptVer>1</RptVer>
<RptTyp>1</RptTyp>
</RptInfo>
</InstRptRoot>
How can I do this and also preserve the formatting (ie linebreaks, spacing, etc.)?
Mark answered your question, I'll answer your second question:
Dim test As String
test = "<RptInfo>" & vbCrLf & vbCrLf & _
vbTab & "<RptVer>1</RptVer>" & vbCrLf & vbCrLf & _
vbTab & "<RptTyp>1</RptTyp> & vbCrLf & vbCrLf & _
"</RptInfo>"
Assuming you want it double-spaced and indented. You had also missed the leading tag, but MarkL caught that as well.
I asked a few month back how to hide a few drop down option on a Classic ASP page which were being pulled from a database so that users could not select those options. But now on one of the remaining options there appear 3 radio box options. I have to remove one of those options. The option which I need to remove is called value="_BML7(B)" according to Chrome.
The last time I inserted the following code into the following code into the include.asp file which worked great but that was to hide drop down options. This I need to hide one radio button option from the current drop down options.
Sub buildDropDownList(strCurrentSelection, objListData, strCodeName, strDescriptionName, blnIncludeOther)
If Not objListData.BOF Then
objListData.MoveFirst
End If
Dim currentCodeValue
While Not objListData.EOF
currentCodeValue = objListData(strCodeName)
If (UCase(currentCodeValue)<>"_04GIDBM") And _
(UCase(currentCodeValue)<>"_05GIDFM") And _
(UCase(currentCodeValue)<>"_03MIS(Q") And _
(UCase(currentCodeValue)<>"_06GIDMS") And _
(UCase(currentCodeValue)<>"_08EXHRM") And _
(UCase(currentCodeValue)<>"_10EXMKT") And _
(UCase(currentCodeValue)<>"_12EXTTH") And _
(UCase(currentCodeValue)<>"_15AFT") And _
(UCase(currentCodeValue)<>"_16HSC") And _
(UCase(currentCodeValue)<>"_18LTD") And _
(UCase(currentCodeValue)<>"_19EBM") And _
(UCase(currentCodeValue)<>"_17EXHSC") Then
Response.Write "<option value='" & currentCodeValue & "' "
If StrComp(strCurrentSelection, currentCodeValue, 1) = 0 then
Response.Write "selected"
End If
Response.Write ">" & objListData(strDescriptionName) & "</option>" & VbCrLf
End If
I could really use the help on this and thank everyone in advance for their help! I not very good with Classic ASP but I'm trying.
Here is the code that I inserted last time on the include.asp file.
<p align="center">
<%
do until rsProgramLevel.EOF
Response.Write "<input type=""radio"" name=""programcode"" onclick=""onProgramCode()"" "
Response.Write "value=""" & rsProgramLevel("ProgramCode") & """ "
if rsProgramLevel("ProgramCode") = strProgramCode then
Response.Write "checked"
end if
Response.Write ">"
Response.Write " "
Response.Write rsProgramLevel("LevelDescription") & " (£" & FormatNumber(rsProgramLevel("ChargeValue"), 2) & ") "
Response.Write " "
rsProgramLevel.MoveNext
loop
%>
</p>
You could compile the list into a string, like so...
Const ignoreCodes = " _04GIDBM _05GIDFM _03MIS(Q _06GIDMS _08EXHRM _10EXMKT _12EXTTH _15AFT _16HSC _18LTD _19EBM _17EXHSC "
Add it to the very top of your file (after any Option Explicit commands). If you have new codes to add to it simply ensure that there's a space either side of it.
Then just test against it...
If Instr(ignoreCodes, UCase(currentCodeValue)) = 0 Then
Response.Write("<option value='" & currentCodeValue & "' ")
If StrComp(strCurrentSelection, " " & currentCodeValue & " ", 1) = 0 then
Response.Write " selected "
End If
Response.Write(">" & objListData(strDescriptionName) & "</option>")
End If
If you think about this further, then simply include the list in a redundant codes table in a database.
To make this simple, just wrap the code sending the HTML with a basic If..Then statement:
Dim currentCode
do until rsProgramLevel.EOF
currentCode = rsProgramLevel("ProgramCode")
If UCase(currentCode)<>"_BML7(B)" Then
Response.Write "<input type=""radio"" name=""programcode"" onclick=""onProgramCode()"" "
Response.Write "value=""" & currentCode & """ "
if rsProgramLevel("ProgramCode") = strProgramCode then
Response.Write "checked"
end if
Response.Write ">"
Response.Write " "
Response.Write rsProgramLevel("LevelDescription") & " (£" & FormatNumber(rsProgramLevel("ChargeValue"), 2) & ") "
Response.Write " "
End If
rsProgramLevel.MoveNext
loop
I'm really stuck on a problem so I figured I would get a second opinion(s).
I'm trying to remotely install .exe and .msi to client computers. I have a vb script that downloads the file and runs the file, but there's a few problems. First, I'm having trouble getting it to the run on the local admin account. For testing purposes I'm running it as an Admin and it works fine, but if put on a client computer it would need access to the local Admin.
Secondly, and more importantly, microsoft requires some amount of user input before installing an exe file. I know silent msi install is possible, but I assume silent exe is impossible?
As a solution I'm looking into PsExec, but I feel like I'm missing something here.
For reference, here is my vb script:
Dim TApp
Dim IEObj
Dim tArea
Dim tButton
Const HIDDEN_WINDOW = 12
Const SHOW_WINDOW=1
'Array of Patch files to install.
Dim InstallFiles()
'maximum of 100 workstations to install patches to.
Dim wsNames(100)
Dim numComputers
Dim retVal
Dim PatchFolder
'Create explorer window
Set IEObj=CreateObject("InternetExplorer.Application")
IEObj.Navigate "about:blank"
IEObj.Height=400
IEObj.Width=500
IEObj.MenuBar=False
IEObj.StatusBar=False
IEObj.ToolBar=0
set outputWin=IEObj.Document
outputWin.Writeln "<title>RemotePatchInstall version 1.0</title>"
outputWin.writeln "<HTA:APPLICATION ID='objPatchomatic' APPLICATIONNAME='Patchomatic' SCROLL='no' SINGLEINSTANCE='yes' WINDOWSTATE='normal'>"
outputWin.writeln "<BODY bgcolor=ButtonFace ScrollBar='No'>"
outputWin.writeln "<TABLE cellSpacing=1 cellPadding=1 width='75pt' border=1>"
outputWin.writeln "<TBODY>"
outputWin.writeln "<TR>"
outputWin.writeln "<TD>"
outputWin.writeln "<P align=center><TEXTAREA name=Information rows=6 cols=57 style='WIDTH: 412px; HEIGHT: 284px'></TEXTAREA></P></TD></TR>"
outputWin.writeln "<TR>"
' outputWin.writeln "<TD><P align=center><INPUT id=button1 style='WIDTH: 112px; HEIGHT: 24px' type=button size=38 value='Install Patches' name=button1></P></TD>"
outputWin.writeln "</TR>"
outputWin.writeln "<TR>"
outputWin.writeln "<TD></TD></TR></TBODY></TABLE>"
outputWin.writeln "</BODY>"
IEObj.Visible=True
'Get the Information textarea object from the window
set tempObj=outputWin.getElementsByName("Information")
objFound=false
'loop through its object to find what we need
For each objN in tempObj
if objN.name="Information" then
objFound=true
set tArea=objN
end if
next
'if we didnt find the object theres a problem
if ObjFound=False then
'so show an error and bail
MsgBox "Unable to access the TextBox on IE Window",32,"Error"
WScript.Quit
end if
'*************************
'ADMINS: The below is all you should really have to change.
'*************************
'Change this to the location of the patches that will be installed.
'they should be limited to the amout you try to install at one time.
'ALSO the order they are installed is how explorer would list them by alphabetically.
'So given file names:
'patch1.exe
'patch2.exe
'patch11.exe
'installation order would be patch1.exe,patch11.exe, patch2.exe
PatchFolder="C:\IUware Online\Install\"
'Change this to location where the patches will be copied to on remote cp. This directory must exist on remote computer.
'I have it hidden on all workstations.
RemotePatchFolder="C:\Users\jorblume\Backup\"
'Workstation names to refer to as array
wsNames(1)="129.79.205.153"
'wsNames(2)="192.168.0.11"
'number of remote computers
numComputers=1
'**********************
'ADMINS: The above is all you should really have to change.
'**********************
'Copy files to remote computers.
'Get a list of the executable file in the folder and put them into the InstallFiles array
'on return, retVal will be number of files found.
retVal=GetPatchFileList (PatchFolder,InstallFiles)
'for each file copy to remote computers
For cc=1 to numComputers 'for each computer
For i = 1 to retVal 'for each file
Dim copySuccess
Dim SharedDriveFolder
'do a replacement on the : to $, this means you must have admin priv
'this is because i want to copy to "\\remotecpname\c$\PathName"
SharedDriveFolder=replace(RemotePatchFolder,":","$")
'copy it from the PatchFolder to the path on destination computer
'USE: RemoteCopyFile (SourceFilePath,DestinationFilePath, RemoteComputerName)
CurrentCP=cc
copySuccess=RemoteCopyFile(PatchFolder & "\" & InstallFiles(i),SharedDriveFolder,wsNames(CurrentCP))
if copySuccess=true then
tArea.Value=tArea.Value & PatchFolder & "\" & InstallFiles(i) & " copy - OK" & vbcrlf
else
tArea.Value=tArea.Value & PatchFolder & "\" & InstallFiles(i) & " copy - FAILED" & vbcrlf
end if
Next
Next
'Install the files on remote computer
'go through each filename and start that process on remote PC.
'for each file install them on the computers.
For cc=1 to numComputers
'if theres more than one patch
if retVal>1 then
For i=1 to retVal-1
CurrentCp=cc
'Now create a process on remote computer
'USE: CreateProcessandwait( ComputerName, ExecutablePathonRemoteComputer
'Create a process on the remote computer and waits. Now this can return a program terminated which is ok,
'if it returns cancelled it means the process was stopped, this could happen if the update required a
'computer restart.
CreateProcessandWait wsNames(CurrentCP), RemotePatchFolder & InstallFiles(i) & " /quiet /norestart", tArea
next
end if
'do the last patch with a forcereboot
CreateProcessandWait wsNames(CurrentCP), RemotePatchFolder & InstallFiles(retVal) & " /quiet" & " /forcereboot" , tArea
next
tArea.value=tArea.Value & "Script Complete!" & vbcrlf
'**************************** FUNCTIONS
'Get list of files in Folder.
Function GetPatchFileList(FileFolder, FileStringArray())
'create file system object
Set objFS=CreateObject("Scripting.FileSystemObject")
'set the a variable to point to our folder with the patches in it.
Set objFolder=objFS.GetFolder(FileFolder)
'set the initial file count to 0
numPatches=0
for each objFile in objFolder.Files
if UCase(Right(objFile.Name,4))=".EXE" then
numPatches=numPatches+1
redim preserve FileStringArray(numPatches)
FileStringArray(numPatches)=objFile.Name
end if
next
GetPatchFileList=numPatches
End Function
'Copy files to remote computer.
Function RemoteCopyFile(SrcFileName,DstFileName,DestinationComputer)
Dim lRetVal
'create file system object
Set objFS=CreateObject("Scripting.FileSystemObject")
lRetVal=objFS.CopyFile (SrcFileName, "\\" & DestinationComputer & "\" & DstFileName)
if lRetVal=0 then
RemoteCopyFile=True
else
RemoteCopyFile=False
end if
End Function
'Create process on remote computer and wait for it to complete.
Function CreateProcessAndWait(DestinationComputer,ExecutableFullPath,OutPutText)
Dim lretVal
strComputer= DestinationComputer
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2:Win32_Process")
Set objWMIServiceStart= GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2:Win32_ProcessStartup")
Set objConfig = objWMIServiceStart.SpawnInstance_
objConfig.ShowWindow = 1 'show window or use HIDDEN_WINDOW
lretVal= objWMIService.Create(ExecutableFullPath, null, objConfig, intProcessID)
if lretVal=0 then
OutPutText.Value = OutPutText.Value & "Process created with ID of " & intProcessID & " on " & DestinationComputer & vbcrlf
OutPutText.Value = OutPutText.Value & " Waiting for process " & intProcessID & " to complete." & vbcrlf
WaitForPID strComputer, intProcessID,OutPutText
OutPutText.Value = OutPutText.Value & "Process complete." & vbcrlf
else
OutPutText.Value = OutPutText.Value & "Unable to start process " & ExecutableFullPath & " on " & DestinationComputer & vbcrlf
end if
End Function
'Wait for PRocess to complete
Function WaitForPID(ComputerName,PIDNUMBER,OutPutText)
Dim ProcessNumber
Set objWMIServiceQ = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & ComputerName & "\root\cimv2")
Set colItems = objWMIServiceQ.ExecQuery("Select * from Win32_Process",,48)
For Each objItem in colItems
'check if this process is the one we are waiting for
if objItem.ProcessID=PIDNUMBER then
OutPutText.Value = OutPutText.Value & "Process Info:" & vbcrlf
OutPutText.Value = OutPutText.Value & " Description: " & objItem.Description & vbcrlf
OutPutText.Value = OutPutText.Value & " ExecutablePath: " & objItem.ExecutablePath & vbcrlf
OutPutText.Value = OutPutText.Value & " Name: " & objItem.Name & vbcrlf
OutPutText.Value = OutPutText.Value & " Status: " & objItem.Status & vbcrlf
OutPutText.Value = OutPutText.Value & " ThreadCount: " & objItem.ThreadCount & vbcrlf
ProcessNumber=objItem.ProcessID
end if
Next
PidWaitSQL="SELECT TargetInstance.ProcessID " & " FROM __InstanceDeletionEvent WITHIN 4 " _
& "WHERE TargetInstance ISA 'Win32_Process' AND " _
& "TargetInstance.ProcessID= '" & ProcessNumber & "'"
Set Events = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & ComputerName & "\root\cimv2").ExecNotificationQuery (PidWaitSQL)
Set TerminationEvent = Events.nextevent
OutPutText.Value = OutPutText.Value & "Program " & TerminationEvent.TargetInstance.ProcessID & _
" terminated. " & vbcrlf
set TerminationEvent=Nothing
exit function
End Function
As suggested in the comments, psexec will be your best solution for this scenario. Just don't forget to use /accepteula in its syntax to ensure it doesn't effectively "hang" while waiting for someone to accept its EULA. :) If you have questions or issues with psexec in your installs, comment back here.