Writing To Word File

TheMSsForum.com: The Microsoft Software Forum

The MSS Forum ‹ VBscripts
- Archive
  - Biz
  - MCSE
  - CRM
  - Drivers
  - Framework
  - ADO
  - ASP
  - Compact
  - Forms
  - Dotnet
  - C#
  - VB
  - FontpageGen
  - Excel
  - WorkSheet
  - Exchange
  - Setup
  - Fox
  - Fontpage
  - ASP
  - IIS
  - Entourage
  - Money
  - Messanger
  - PocketPC
  - Powerpoint
  - Project
  - Publisher
  - Excel
  - VB
  - Security
  - Portal
  - Services
  - SQLServerDev
  - SVCS
  - SQLServer
  - VB
  - VC
  - MFC
  - ExcelGen

- Previous
  - 1
    - Bug? Date functions get day & month wrong Hi all, I am using the regional date time settings as English(Australian). That means that my date settings will always display as day/month/year I have an app which I'm entering a date. It's written in VB. When I intercept my field after its been entered and use VBScript to display a msgbox to screen I get funny results which seem to be a VB Script bug. I enter 11/01/2006 (which means in my lingo 11th Jan 2006) I then display msgbox DAY(myfield) & MONTHNAME(Month(myfield)) & YEAR(myfield) and lo I get "1Nov2006". I can also use MSGBOX FormatDateTime(myfield,1) and get Wednesday, 1 November 2006 Clearly they are wrong. I need to get, respectively 11Jan2006 and Wednesday 11 January 2006. HOWEVER!!! As soon as the first two characters of my date are 13 or more then it understands correctly what my date is - that's because there's no months greater than 13 so I guess it's assuming that I need the format changed to d/m/y. Then as soon as the first two chars are 12 or less, then it goes back to m/d/y. Is there a fix for this? Tag: Writing To Word File Tag: 185313
  - 2
    - VBS and Excel (Conditional Formatting) Hi I can use VBS to do most things in Excel (copy/paste/create spreadsheets etc), but I cannot get Conditional Formatting to work. I've googled and haven't came up with anything that relates to VBS, only VBA. The code that Excel makes up from a Macro is: Selection.FormatConditions.Delete Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _ Formula1:="80" Selection.FormatConditions(1).Font.ColorIndex = 3 VBS accepts the .Delete line, but if I try to add one, it comes up with errors using the above code. IE The below works Set objXL = WScript.CreateObject("Excel.Application") objxl.Selection.FormatConditions.Delete But objXL.Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, Formula1:="80" doesn't. Does anyone know what syntax I should use to get it to work? Cheers Leon Tag: Writing To Word File Tag: 185310
  - 3
    - Faster than Ping? Is there a way of finding out if a machine is online that is faster than ping? I've been using the WMI technique rather than the .Run method. Regards, Bruce. Tag: Writing To Word File Tag: 185309
  - 4
    - Scripting WINS Is there a means for talking to the WINS servers? My services file mentions wins 1512/tcp #Microsoft Windows Internet Name Service wins 1512/udp #Microsoft Windows Internet Name Service Is there a way of scriptfully interacting with WINS? Regards, Bruce. Tag: Writing To Word File Tag: 185308
  - 5
    - ActiveDesktop and GetObject In my HTA I have a line Set oIADSUser = GetObject( Subst( "WinNT://[1]/[2],user", Array( sDomain, sUsername ) ) ) It was suggested to me that I might want to convert the HTA into an ActiveDesktop object. I tried it but it keeps failing on this GetObject line. Is there a workaround or is this a known limitation? Regards, Bruce. Tag: Writing To Word File Tag: 185307
  - 6
    - Sql query via a form button on a web page. Hi, I have an area of web page that I do query to display display some information. It is basically a Select statement to display everything in the table, which loops around till everything is displayed. That works fine and dandy. I want to create three buttons to display information for "Past 24 Hours", "Past 72 Hours", and "All Entry's" I am not sure the best way to do this, any ideas? OH, the select statement for 24 hours, 72, or all entries I have but the part I am not sure is how to put the code into the buttons. thanks in advance, Tag: Writing To Word File Tag: 185306
  - 7
    - Terminating a script / Content missing from MSDN page I'm trying to terminate a process on my local PC using WMI's .ProcessTerminate method. It's returning a value of 2 ("Access Denied"). I can kill the same process from Task Manager without difficulty. I searched MSDN for this situation and came up with the following page: "Terminate Method of the Win32_Process Class" (http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wmisdk/wmi/terminate_method_in_class_win32_process.asp). This page mentions enabling the SeDebugPrivilege privilege through VBScript to get around this error; however, the the VBScript code that would illustrate how to enable the SeDebugPrivilege privilege seems to be missing from the page! Any idea where this--or similar--code can be found? Tag: Writing To Word File Tag: 185294
  - 8
    - Remote Code Execution I'm in a Windows AD environment that isn't very conducive to running startup scripts to achieve my goal. What I am trying to do is copy a vbs script to a remote client machine, and then execute that script on that machine using my credentials. The script itself, when manually run on a client works perfectly. What I can't get to work is the remote execution of the script. I can start a process for notepad.exe and calc.exe, but I cannot start the script itself. Any ideas? Tag: Writing To Word File Tag: 185293
  - 9
    - Restart script for domain users Hi folks, I'm trying to write a script (still not sure it is the best option though) to allow our end users to restart their PCs each night. Here is our scenario: -users do not have access to the command prompt (blocked by GP) -users do not have access to shutdown or restart the computers (blocked by GP) -users do not have admin rights -we want user's to reboot their systems every night without having the option to shut the machine off Now here are the two options I think we have, I would prefer the first but I'm working on the second at the moment: 1) Use group policy to bock access to Shutdown but allow access to Restart. Alternatively we could do this by a reg hack but I don't have any clue how to do it either way. 2) Create a script that we can place on each user's Start Menu to reboot the computer. This script would need to run with elevated privileges (we have an account we can use which has access to reboot the workstations). I'm really new to scripting so I'm kind of fumbling my way along here but I have managed to write a script (with help from a couple sites) that reboots a test workstation using alternate credentials but the command prompt is not blocked on that system. When I do block it, the script doesn't work - says action blocked by policy. Does anyone have any ideas on how I can go about doing this? Now my second question on this script. As I need to embed the username and password in the file, is there any way to prevent users from being able to view this account information (we have a couple savvy folks). And my last question (I promise) - when I double-click on the script while logged in as a regular user (not power user) it doesn't work but if I launch it from a command prompt it does. When I double click on it as administrator it works with no problems. How do I get around this? Any and all help is greatly appreciated!!!! Thanks in advance, Nancy Tag: Writing To Word File Tag: 185290
  - 10
    - HTML & VBScript -> security problem!? Hello, I am trying to develop an simple desktop background that shows some system information using WMI. A .vbs script is allready working and this script works in an html application too. The problem is that you can't make an .hta your desktop wallpaper and a simple html file with this vbscript causes an error "ActiveX Can't Create Object": Set objWMIService = GetObject("winmgmts:" & "!\\mycomputername\root\cimv2") Has anybody an idea how to adjust security settings to make this work or what else I could try? Kind regards, Sebastian Tag: Writing To Word File Tag: 185279
  - 11
    - Is there a way to get ip address and upload it ? Is there a way to get ip addess from www.whatismyip.com and then upload it to ftp ? Thanks Tag: Writing To Word File Tag: 185277
  - 12
    - Up time Hi, Is there an object.property I can look at that will give me the up time of a system? Thanks in advance, JeffH Tag: Writing To Word File Tag: 185268
  - 13
    - Inscrutable Type Mismatch Error I've taken Charles Oppermann's excellent phone directory command line VBS and tried to use it as a web application. I have added the necessary input field and output location but the very end of the script throws Microsoft VBScript runtime error '800a000d' Type mismatch errors. My entire site utilizes user authentication so I know that the problem can't be there but I'm missing something else, perhaps in my variable declaration. The specific line causing the error is in the final loop: strDisplayLine = objADORecordset.Fields("cn").Value & vbTab = = = = = = = = = = <%@ LANGUAGE="VBSCRIPT" %> <% Option Explicit %> <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"> <html> <head> <title>LDAP Lookup</title> <style type="text/css"> body, input, select, table, textarea { font-size: 9pt; font-family: arial; } .niceButton { font-size : 9pt; font-family : arial; background-color : #eaeaea; color : #333333; font-weight : bold; border-width : thin; } </style> <% dim strPerson, objADsRootDSE, strADsPath, strBase, strObjects, strName, strAttributes, strScope, objADOConnection, objADOCommand, objADORecordset, strDisplayLine, strFilter strPerson = trim(request.form("last")) ' Input box is not empty and Cancel button was not clicked ' Build the query string ' Active Directory OLEDB Provider format has four parts separated by semi-colons: ' Root: which is the starting point for the search ' Filter: conditions to search on, using RFC 2254 format ' Attributes: attributes to return ' Scope: base, onelevel or subtree for entire directory partition ' Specify the search base. ' We'll use the global catalog for performance reasons since the ' Name and Telephone number attributes are available from the GC ' First, need to discover the local global catalog server Set objADsRootDSE = GetObject("GC://RootDSE") ' Form an ADsPath string to the DN of the root of the Active Directory forest strADsPath = "GC://" & objADsRootDSE.Get("rootDomainNamingContext") ' Wrap the ADsPath with angle brackets to form the base string strBase = "<" & strADsPath & ">" ' Release the ADSI object, no longer needed Set objADsRootDSE = Nothing ' Specify the LDAP filter ' First, indicate the category of objects to be searched (all people, not just users) strObjects = "(objectCategory=person)" ' If user enters "*", then filter on all people If (strPerson = "*") Then strName = "(sn=*)" Else strName = "(sn=" & strPerson & "*)" End If ' Add the two filters together strFilter = "(&" & strObjects & strName & ")" ' Set the attributes we want the recordset to contain ' We're interested in the common name and telephone number strAttributes = "cn,telephoneNumber" ' Specify the scope (base, onelevel, subtree) strScope = "subtree" ' Create ADO connection using the ADSI OLE DB provider Set objADOConnection = CreateObject("ADODB.Connection") objADOConnection.Open "Provider=ADsDSOObject;" ' Create ADO commmand object and associate it with the connection Set objADOCommand = CreateObject("ADODB.Command") objADOCommand.ActiveConnection = objADOConnection ' Create the command string using the four parts objADOCommand.CommandText = strBase & ";" & strFilter & ";" & strAttributes & ";" & strScope ' Set the number of records in the recordset logical page 'objADOCommand.Properties("Page Size") = 20 ' Set the maximum result size objADOCommand.Properties("Size Limit") = 20 ' Sort the results based on the cn attribute objADOCommand.Properties("Sort On") = "cn" ' Execute the query for the user in the directory Set objADORecordset = objADOCommand.Execute If objADORecordset.EOF Then strDisplayLine = "No records were found." Else ' Loop through all the returned records While Not objADORecordset.EOF ' Display the row using the selected fields strDisplayLine = objADORecordset.Fields("cn").Value & vbTab ' Check to see if telephone number field is null If IsNull(objADORecordset.Fields("telephoneNumber")) Then strDisplayLine = strDisplayLine & "(number not listed)" Else ' Retrieve telephone number and add to line strDisplayLine = strDisplayLine & objADORecordset.Fields("telephoneNumber") End If ' Advance to the next record objADORecordset.MoveNext Wend End If ' Close the ADO connection objADOConnection.Close %> </head> <body text="#333333"><%=strDisplayLine%></body></html> Tag: Writing To Word File Tag: 185265
  - 14
    - Exclude Files when using robocopy Hi Champs is it possible to run robocopy against a folder but to exclude one or more unwnated filetypes instead of including the wanted file types? Tag: Writing To Word File Tag: 185264
  - 15
    - <Else If> in command line Hi Champs I want to create a backup script which can be used when logged on but also when booted with WinPE = profile not loaded. Is there a way to display all available profiles on that machiene and to choose from to have the choosen profile "added" in the placeholder of the paths I specified in my script? Sample: I run the script and will then have the choice to choose from "Adminstrator" or "User1" or "User2". If I choose the "Administrator" profile, I want that the placeholder in all related paths is taken for the operation: Sample: "%userprofile%\favorites\" becomes "C:\Documents and Settings\Favorites\" Someone in here can follow me? :) Tag: Writing To Word File Tag: 185263
  - 16
    - Move files from one server to another server (same domain) Trying to move edi backup files that start with "@" symbol from one server to another server same domain: See code Option Explicit Dim fso Dim objFolderSource Dim objFolderDestination Dim colFiles Dim objFile Dim strSourceDir Dim strDestinationDir Dim ArchiveDate Dim starttime strSourceDir = "\\server1\c$\q32w" strDestinationDir = "\\server2\d$\QualediBackup" starttime = now() ArchiveDate = dateadd("m",-2,Now()) 'Copy files from source to destination Set fso = CreateObject("Scripting.FileSystemObject") Set objFolderSource = fso.GetFolder(strSourceDir) Set colFiles = objFolderSource.Files For each objFile in colFiles 'msgbox objFile.Name & " - " & objFile.DateLastModified If Left(objFile.name, 1) = "@" Then objFile.Copy (strDestinationDir) End If Next 'clean up set fso = nothing set objFolderSource = nothing set objFolderDestination = nothing When script runs I get a Permission denied error. Any ideas? Is my code wrong? Tag: Writing To Word File Tag: 185254
  - 17
    - How do I know, when sending is ready??? How do I know, when sending is ready??? I need to know, so I can disconnect the dial-up connection. Thanks in advence Andries SCRIPT: ' Force explicit declaration of all variables. Option Explicit '***** DECLARATIONS***************************** 'Variables Dim ReportFile, fName, objShell, oArgs Dim strTo, strSubject, strBody Dim objMail, iConf, Flds, i 'Constants 'Who the e-mail is from (this needs to have an e-mail address in it for the e-mail to be sent) Const strFrom = "from@emeel.org" 'Who the carbon copies are sent to Const strCopy = "copy@emeel.org" 'Who the blind copies are sent to Const strBCopy = "" Const ReportPath = "C:\" 'Creates the main objects of the script Set objShell = WScript.CreateObject("WScript.Shell") Set objMail = Wscript.CreateObject("CDO.Message") Set iConf = CreateObject("CDO.Configuration") Set Flds = iConf.Fields '*****[ MAIN SCRIPT ]***************************** Set oArgs = WScript.Arguments For i = 0 to oArgs.Count - 1 ReportFile = oArgs(i) Next fName = ReportPath & ReportFile 'Who the e-mail is sent to strTo = "to@emeel.net" 'Set the subject of the e-mail strSubject = "Automatic on: " 'Set the main body of the e-mail strBody = "AUTO" With Flds .Item("http://schemas.microsoft.com/cdo/configuration/sendusing").Value = 2 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver").Value = "smtp.server" .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport").Value= 25 .UpdateEnd WithSet objMail.Configuration = iConfobjMail.To = strToobjMail.CC = strCopyobjMail.BCC = strBCopyobjMail.From = strFromobjMail.Subject = strSubject & NowobjMail.TextBody = strBodyIf ReportFile <> "" Then objMail.AddAttachment(fName)End IfobjMail.Send'clean upSet Flds=nothingSet iConf=nothingSet objMail = NothingWScript.Quit Tag: Writing To Word File Tag: 185251
  - 18
    - Objects Hi, Is there a way that I can obtain a list of objects that are available to me from my workstation? Thanks in Advance, JeffH Tag: Writing To Word File Tag: 185250
  - 19
    - Event Log Backup and Clearing I had a requirement to create a script that backups Event Logs in text and monitor for specific events, emailing the results to a person. This is what I've come up with so far... the only thing I haven't done yet is Query the eventlog before I clear it, and send the results to the email body somehow. Any help would be appreciated. I realize this code isn't clean, but it's my first... so don't flame me too bad =] -Chris ' on error resume next dtmThisDay = Day(Date) dtmThisMonth = Month(Date) dtmThisYear = Year(Date) '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''' Declare what computers to execute this script upon'''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Set objNet = WScript.CreateObject( "WScript.Network" ) strFilename = "workstations.txt" Set objFSO = CreateObject("Scripting.FileSystemObject") Set objTextStream = objFSO.OpenTextFile(strFilename, 1) ' Start Loop Do Until objTextStream.AtEndOfStream strComputer = objTextStream.ReadLine Wscript.Echo "Working on Machine " & strComputer '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''' Create audit directories '''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Set objFSO = CreateObject("Scripting.FileSystemObject") If not objFSO.FolderExists("Z:\scripts\audits\" & strComputer) Then Set objFolder = objFSO.CreateFolder("Z:\scripts\audits\" & strComputer) End If If not objFSO.FolderExists("Z:\scripts\audits\" & strComputer & "\" & dtmThisMonth & "-" & dtmThisDay & "-" & dtmThisYear) Then Set objFolder = objFSO.CreateFolder("Z:\scripts\audits\" & strComputer & "\" & dtmThisMonth & "-" & dtmThisDay & "-" & dtmThisYear) End If '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' '''''''''Create audit files''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Set objFSO = CreateObject("Scripting.FileSystemObject") ' Set objFile = objFSO.CreateTextFile("Z:\scripts\audits\" & strComputer & "\" & dtmThisMonth & "-" & dtmThisDay & "-" & dtmThisYear & "\Application.txt") ' Set objFile = objFSO.CreateTextFile("Z:\scripts\audits\" & strComputer & "\" & dtmThisMonth & "-" & dtmThisDay & "-" & dtmThisYear & "\Security.txt") ' Set objFile = objFSO.CreateTextFile("Z:\scripts\audits\" & strComputer & "\" & dtmThisMonth & "-" & dtmThisDay & "-" & dtmThisYear & "\System.txt") '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' '''''''''Open Application Log''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Set objFSO = CreateObject("Scripting.FileSystemObject") Set objTextFile = objFSO.OpenTextFile _ ("Z:\scripts\audits\" & strComputer & "\" & dtmThisMonth & "-" & dtmThisDay & "-" & dtmThisYear & "\ApplicationLog.txt", 8, True) Set objWMIService = GetObject("winmgmts:" _ & "{impersonationLevel=impersonate}!\\" _ & strComputer & "\root\cimv2") Set colLoggedEvents = objWMIService.ExecQuery _ ("Select * from Win32_NTLogEvent " _ & "Where Logfile = 'Application'") For Each objEvent in colLoggedEvents objTextFile.WriteLine ("==============================" & VBNewLine _ & "Category: " & objEvent.Category & VBNewLine _ & "Computer Name: " & objEvent.ComputerName & VBNewLine _ & "Event Code: " & objEvent.EventCode & VBNewLine _ & "Message: " & objEvent.Message & VBNewLine _ & "Record Number: " & objEvent.RecordNumber & VBNewLine _ & "Source Name: " & objEvent.SourceName & VBNewLine _ & "Time Written: " & objEvent.TimeWritten & VBNewLine _ & "Event Type: " & objEvent.Type & VBNewLine _ & "User: " & objEvent.User) Next objTextFile.Close Set colLogFiles = objWMIService.ExecQuery _ ("Select * from Win32_NTEventLogFile where LogFileName='Application'") For Each objLogfile in colLogFiles objLogFile.ClearEventLog() Next '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' '''''''''Security''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Set objFSO = CreateObject("Scripting.FileSystemObject") Set objTextFile = objFSO.OpenTextFile _ ("Z:\scripts\audits\" & strComputer & "\" & dtmThisMonth & "-" & dtmThisDay & "-" & dtmThisYear & "\SecurityLog.txt", 8, True) Set objWMIService = GetObject("winmgmts:" _ & "{impersonationLevel=impersonate,(Backup, Security)}!\\" _ & strComputer & "\root\cimv2") Set colLoggedEvents = objWMIService.ExecQuery _ ("Select * from Win32_NTLogEvent " _ & "Where Logfile = 'Security'") For Each objEvent in colLoggedEvents objTextFile.WriteLine("==============================" & VBNewLine _ & "Category: " & objEvent.Category & VBNewLine _ & "Computer Name: " & objEvent.ComputerName & VBNewLine _ & "Event Code: " & objEvent.EventCode & VBNewLine _ & "Message: " & objEvent.Message & VBNewLine _ & "Record Number: " & objEvent.RecordNumber & VBNewLine _ & "Source Name: " & objEvent.SourceName & VBNewLine _ & "Time Written: " & objEvent.TimeWritten & VBNewLine _ & "Event Type: " & objEvent.Type & VBNewLine _ & "User: " & objEvent.User) Next objTextFile.Close Set colLogFiles = objWMIService.ExecQuery _ ("Select * from Win32_NTEventLogFile where LogFileName='Security'") For Each objLogfile in colLogFiles objLogFile.ClearEventLog() Next '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' '''''''''System''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Set objFSO = CreateObject("Scripting.FileSystemObject") Set objTextFile = objFSO.OpenTextFile _ ("Z:\scripts\audits\" & strComputer & "\" & dtmThisMonth & "-" & dtmThisDay & "-" & dtmThisYear & "\SystemLog.txt", 8, True) Set objWMIService = GetObject("winmgmts:" _ & "{impersonationLevel=impersonate}!\\" _ & strComputer & "\root\cimv2") Set colLoggedEvents = objWMIService.ExecQuery _ ("Select * from Win32_NTLogEvent " _ & "Where Logfile = 'System'") For Each objEvent in colLoggedEvents objTextFile.WriteLine("==============================" & VBNewLine _ & "Category: " & objEvent.Category & VBNewLine _ & "Computer Name: " & objEvent.ComputerName & VBNewLine _ & "Event Code: " & objEvent.EventCode & VBNewLine _ & "Message: " & objEvent.Message & VBNewLine _ & "Record Number: " & objEvent.RecordNumber & VBNewLine _ & "Source Name: " & objEvent.SourceName & VBNewLine _ & "Time Written: " & objEvent.TimeWritten & VBNewLine _ & "Event Type: " & objEvent.Type & VBNewLine _ & "User: " & objEvent.User) Next objTextFile.Close Set colLogFiles = objWMIService.ExecQuery _ ("Select * from Win32_NTEventLogFile where LogFileName='System'") For Each objLogfile in colLogFiles objLogFile.ClearEventLog() Next Loop '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' '''''''''Email'''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Set objEmail = CreateObject("CDO.Message") objEmail.From = "edit@edit.com" objEmail.To = "edit@edit.com" objEmail.Subject = "Audit Report for " & dtmThisMonth & "-" & dtmThisDay & "-" & dtmThisYear objEmail.Textbody = "Audits have been completed." & VBNewLine & VBNewLine _ & "Here are the Log-in failures" & VBNewLine & VBNewLine objEmail.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 objEmail.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = _ "edit.server.com" objEmail.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 objEmail.Configuration.Fields.Update objEmail.Send Tag: Writing To Word File Tag: 185248
  - 20
    - Script for sending Email from outlook with a attachment I want to send email from Outlook with a Excel attachment. Please kindly share the script for the same. Thanks Karen Tag: Writing To Word File Tag: 185247
  - 21
    - delete users Hi everybody In Windows 2003 & AD How delete all users from member of "Domain Users" Thanks for help Artur Tag: Writing To Word File Tag: 185245
  - 22
    - How to Use Mailto Script to send HTLM mail ? Hi How to Use Mailto Script to send HTLM mail ? Like : window.location.href = " mailto:test@test.com?subject=TestSubject&body=" & htmlBody Thanks in advence Hung Tag: Writing To Word File Tag: 185244
  - 23
    - Change PC's from one domain to other domain. Hi. I have a server with Windows 2000 Active Directory Domain and 200 computers joined to that domain. I need to change those computers to a server with a new Windows 2003 Active Directory Domain. For Example, change all computers from test1.domain.com to test2.domain.com. Is there any Script or GPO or anything to do this without going to each computer and change the domain? any ideas? -- Thanks Troper Tag: Writing To Word File Tag: 185242
  - 24
    - filter doesn't do what I expect I have something very simple: Set objOU = GetObject("LDAP://ou=someOU,dc=myDomain,dc=com") objOU.Filter = Array("user") For Each objUser In objOU Wscript.Echo objUser.distinguishedName Next There happens to be a few computers in various OUs and the filter method spits out the computer names as well as the users. Is there another way to only get the users in that specific OU? TIA. Tag: Writing To Word File Tag: 185241
  - 25
    - Set outlook as default e-mail client Hi All, I need to set Microsoft Outlook 2002/2003 as the default e-mail client using a script. I have to perform this on bulk of users so I would appreciate other methods. Using Internet Properties --> Programs --> e-mail is not sufficient for me. Thanks, Yaman Tag: Writing To Word File Tag: 185240
- Next
  - 1
    - Checking if a file is opened Hi, I am looking for a solution to find out if a file is opened in a windows (NT oder W2k or XP) application. For office documents it seems to be clear: trying to open the document exclusively - if that is succesful, the document is not opened. But what can I do if I want to know if, for example, a text file is opened in notepad? If you want you can rename or delete the file while it is opened in notepad. I think it's the same for documents in wordpad or images in paint. In this case the file always can be opened exclusively. Maybe it is possible to run a VBScript that checks the running aplications and their window titles? But thinking about that I see two problems: 1. consider 2 text files c:\dir1\test.txt and c:\dir2\test.text (same file names but different directories. If both of these files are opened in notepad I would have two windows using the same title "test.txt - Notepad". Is there a chance to find out which file is opened in which notepad? 2. Consider applications that open all documents in one window. In this case you will have only one application window using different window titles depending on the document that is in front. I hope, someone has an idea how to find a solution. Thanks very much in advance! Frank Tag: Writing To Word File Tag: 185234
  - 2
    - Change Registry Key on a different computer Hi. I need to set a registry value on a computer different from the one where the script will be run. I've never really had to do anything with the registry before. I think I found some examples on this group, but I'd like to get some clarification, if someone wouldn't mind taking the time. I found this example: set shell = createobject("wscript.shell") basekey = "HKEY_LOCAL_MACHINE\SYSTEM\ControlSet001\" key = basekey & "Control\ComputerName\ComputerName\ComputerName" shell.regwrite key,strUserIn In the example it seems that strUserIn would be the value of the registry, yes? So if I want the value of this registry key to be "XXX", then I could do this, right? HKEY_LOCAL_MACHINE\SOFTWARE\ASCI\ActiveBatch\Current_Version\JobSched\SMTPFrom set shell = createobject("wscript.shell") sValue = "XXX" key = "HKEY_LOCAL_MACHINE\SOFTWARE\" & _ "ASCI\ActiveBatch\Current_Version\JobSched\SMTPFrom" shell.regwrite key,sValue I suppose what I don't get is how to make it run on a different computer. Could someone explain that part? Thanks, Jennifer Tag: Writing To Word File Tag: 185233
  - 3
    - vbscript fails to execute Hey folks, Have a script with a few lines of code which are supposed to call and execute another vb script, it doesn't. I can't see anything wrong with it. Any thoughts? Thanks Function Main() Dim strTime strTime = "false" While strTime = "false" Dim Shell Set Shell = CreateObject("WScript.Shell") Shell.Run "%comspec% /c cscript.exe d:\Courion\ADDiscovery.vbs", 0, True strTime = "true" Wend Main = DTSTaskExecResult_Success End Function Tag: Writing To Word File Tag: 185231
  - 4
    - Enumerate group membership I am trying to enumerate the group membership for a user at logon. I need to know about every group, so I must use a recursive function to check the group membership of each group (I use a different procedure to get the primary group as the memberOf attribute does not contain this info). I have the following which I modeled on the work of Richard Mueller - www.rlmueller.net. His program works great, but I wanted something that did not rely on a dictionary object outside of the procedure to store values. I am storing and passing values within the function. My function works, but I get repeated group names if the group type is domain local. I can't seem to add logic that corrects this problem. Any suggestions? Call to the function from main program is something like this: strValue=EnumGroups(ADObject, "",TRUE) Function EnumGroups(fobjADObject,fstrStoreValue,fCallFirst) Dim arrGroups Dim objGroup Dim intCount Dim strMyTempValue Dim strSAMname strMyTempValue = "" strSAMname = UCase(fobjADObject.sAMAccountName) If fCallFirst = False Then If Not InStr(fstrStoreValue,"CN=" & strSAMName) Then If Not fstrStoreValue = "" Then strMyTempValue = fstrStoreValue & "CN=" & strSAMname & Chr(10) Else strMyTempValue = "CN=" & strSAMname & Chr(10) End If End If End If arrGroups = fobjADObject.memberOf '** The AD object contains no groups. In this case, the function is set '** to the value of the passed value holder if it is NOT empty and if '** the string isn't already there. If IsEmpty(arrGroups) Then If Not InStr(fstrStoreValue,"CN=" & strSAMname) Then EnumGroups = strMyTempValue End If Exit Function End If '** If the item returned from the memberOf method is a string, then '** recurse for the group to check for its memberships and add results '** to the value of the function. If TypeName(arrGroups) = "String" Then Set objGroup = GetObject("LDAP://" & arrGroups) strMyTempValue = EnumGroups(objGroup,strMyTempValue,False) EnumGroups = strMyTempValue Set objGroup = Nothing Exit Function End If '** The arrGroups is NOT empty and is not a string, so it must be an '** array of groups. Recurse for each group in the array and add results '** to the value of the function. For intCount = 0 To UBound(arrGroups) Set objGroup = GetObject("LDAP://" & arrGroups(intCount)) strMyTempValue = EnumGroups(objGroup,strMyTempValue,False) Set objGroup = Nothing Next EnumGroups = strMyTempValue End Function '** EnumGroups Tag: Writing To Word File Tag: 185230
  - 5
    - Permission Denied error I am trying to replace the Office 2000 shorcuts with Office XP shortcuts. The shorcuts are located on all of the users desktops, in a folder called "Applications". The script I have written gives me a Permission Denied error, even when I try to run the script locally on my PC and I am an administrator. The script works fine if I just replace the icons on the desktop, but not when I try to replace the icons in the Applications folder. Here is what I have for a script(the variables are in a dim statement at the beginning of the script): 'Replace Office 2000 shorcuts with Office XP shortcuts Set oShell = CreateObject("WScript.Shell") Set oFSO = CreateObject("scripting.FileSystemObject") aDesktopPath = oShell.SpecialFolders("Desktop") & "\Applications" oFSO.CopyFile "\\pusher\apps\OfficeXPShortcuts\Microsoft Access.lnk", aDesktopPath, True Thank you for any advice you can give! Tag: Writing To Word File Tag: 185228
  - 6
    - Permission Denied error I have a script that I am trying to get to work. It is suppose to replace some existing shorcuts with new ones. The shortcuts are located in a folder called "Applications" on all of the users desktops. The script works if the shorcuts are on the desktop, but not when they are in the Applications folder. The script doesn't even work on my PC and I am an administrator. Any help is greatly appreciated. Here is what I have, the variables are in a dim statement at the beginning of the script: 'Replace Office 2000 shorcuts with Office XP shortcuts Set oShell = CreateObject("WScript.Shell") Set oFSO = CreateObject("scripting.FileSystemObject") aDesktopPath = oShell.SpecialFolders("Desktop") & "\Applications" oFSO.CopyFile "\\pusher\apps\OfficeXPShortcuts\Microsoft Access.lnk", aDesktopPath, True Tag: Writing To Word File Tag: 185226
  - 7
    - getting information from a NT machine Is it possible for me to retrieve printer information on NT machine which doesnt have any add onsviz internet expl5.0,wsh etc etc... I am trying to gather information from a 2003 machine by giving the name of that NT machine. please revert back to me. cheers, Nuti Tag: Writing To Word File Tag: 185224
  - 8
    - SUB-STRINGing in VBScript I wrote a script that reads an input file ('input.txt') that creates an output file ('output.txt') that massages the data and output it to be use as a metadata file. One of the things I'm trying to do (but having problems) is to read a record in the input file and grab the first letter of the word in the row to create an index tag only using the 'first' character. HERE IS A EXAMPLE of my input file and what I would like to create in my output file. I'm trying to substring the first character without any luck. ******[ 'input.txt' ]****** Mary Mike Joe Tom Larry Dick James Paula Jason ******[ 'output.txt' ]****** category="Index",M category="Index",M category="Index",J category="Index",T category="Index",L category="Index",D category="Index",J category="Index",P category="Index",J For example: when my program reads the first row 'Mary', it will output 'category="Index",M', and so on, till end of file. Everything else works good, but having problems is sub-stringing. Thanks! Bre Tag: Writing To Word File Tag: 185220
  - 9
    - syntax error I am getting the following error when trying to insert form data into an Access db: 80040e14|[Microsoft][ODBC_Microsoft_Access_Driver]_Syntax_error_in_string_in_query_expression_''++++_)'. 500 I've traced it down to the following code: 'insert records into db Set con = Server.CreateObject( "ADODB.Connection" ) con.Open "webLeads" SQLstring = "INSERT INTO studentLeads ( la_fName, la_mName, la_lName, la_street, " &_ " la_city, la_state, la_zip, la_country, la_email, la_phone, la_callTime, la_dob, la_age, " &_ " la_education, la_intArea, la_message) VALUES ('" & fixQuotes( form_fName ) & "','" & fixQuotes( form_mName ) & "', " &_ " '" & fixQuotes( form_lName ) & "','" & fixQuotes( form_street ) & "','" & fixQuotes( form_city ) & "', " &_ " '" & fixQuotes( form_stateID ) & "','" & fixQuotes( form_zip ) & "','" & fixQuotes( form_country ) & "', " &_ " '" & fixQuotes( form_email ) & "','" & fixQuotes( form_phone ) & "','" & fixQuotes( form_callTime ) & "', " &_ " '" & fixQuotes( form_dob ) & "','" & fixQuotes( form_age ) & "','" & fixQuotes( form_education ) & "', " &_ " '" & fixQuotes( form_intArea ) & "','" & fixQuotes( form_message ) & " )" con.Execute(SQLstring) con.Close I've also tried it w/ DSN-less connection, w/ same result. Variables are assigned and validated as follows: 'get form data and remove any spaces form_fName=trim(Request.Form("fName")) form_mName=trim(Request.Form("mName")) form_lName=trim(Request.Form("lName")) form_street=trim(Request.Form("street")) form_city=trim(Request.Form("city")) form_stateID=trim(Request.Form("stateID")) form_zip=trim(Request.Form("zip")) form_country=trim(Request.Form("country")) form_email=trim(Request.Form("email")) form_phone=trim(Request.Form("phone")) form_callTime=trim(Request.Form("callTime")) form_dob=trim(Request.Form("dob")) form_age=trim(Request.Form("age")) form_education=trim(Request.Form("education")) form_intArea=trim(Request.Form("intArea")) form_message=trim(Request.Form("message")) 'validate form data IF len(form_fname)< 1 THEN validated_form = false ELSE validated_form = true END IF IF len(form_mname) < 1 THEN validated_form = false ELSE validated_form = true END IF IF len(form_lname) < 2 THEN validated_form = false ELSE validated_form = true END IF IF len(form_street) < 5 THEN validated_form = false ELSE validated_form = true END IF IF len(form_city) < 2 THEN validated_form = false ELSE validated_form = true END IF IF len(form_zip) < 5 THEN validated_form = false ELSE validated_form = true END IF IF (form_country) = "" THEN form_country = "U.S." END IF IF len(form_email) < 6 THEN validated_form = false ELSE validated_form = true END IF IF len(form_phone) < 7 THEN validated_form = false ELSE validated_form = true END IF IF (form_dob) = "" THEN form_dob = "not given" END IF IF (form_age) = "" THEN form_age = "not given" END IF IF (form_intArea)= "" THEN validated_form = false ELSE validated_form = true END IF IF (form_message) = "" THEN form_message = "no message indicated" END IF All form entries are defined as <input type="text"> and also as text fields in the db. There is also a "fixquotes" function that takes care of the ' problem (have used this function over and over in many scripts. I'm sure there's something simple I'm missing here, but maybe I've been looking at it too long. The validation works for return values, and correctly sends email to the user and to someone in the organization. Can anyone see anything in my code that is causing the error and keeping the data out of the db? TIA... ba Tag: Writing To Word File Tag: 185207
  - 10
    - Help on reading a file and producing another in vbs I would like to write a vbscript that reads the below file: FILENAME: raw_data.txt (for example) one two three four five six ..... and produce the following under FILENAME: data.txt [01] title=one chain= "Link", "one" [02] title=two chain= "Link", "two" [03] title=three chain= "Link", "three" [04] title=four chain= "Link", "four" [05] title=five chain= "Link", "five" [06] title=six chain= "Link", "six" The numbering in the brackets has to be incremented. The actual raw data will be about 4000 rows, the above is an example. Thanks for any help! Tag: Writing To Word File Tag: 185206
  - 11
    - print migration Hello folks.. We are begining work on print migration. Just wanted to know as how to get printer inventory using a script which will fetch all the information just by giving the name of the oldserver. We are moving to 2003 server from NT. I am fairly new to scripting.so can u folks help me out. cheers, Nuti Tag: Writing To Word File Tag: 185204
  - 12
    - Porting an Excel macro to the web I have recently written some simple Excel macros that run various statistics on a column of numbers input by the user. I would like to construct a simple website that allows users to paste their own column of numbers and see these same outputs. I have been told that I may need to use VB script to do this. I am happy to learn Vb script, but I am also seeing comments that only Internet Explorer can view these websites effectively. As I say, the actual code is rather simple. I guess my question is, if I want to go to GoDaddy or some entry-level website design tools, what is the simplest way to transform my Excel macros to be used on any website I might construct? Would that be Php? ASP? I am a beginner, but generally can learn to code what I need, as long as there is some kind of "step-by-step" book I can buy. Manny Tag: Writing To Word File Tag: 185202
  - 13
    - Snapshot and/or Run Macro Stuck on Xmas Eve. I am helping a school district with a problem on either Run Macro or how to display a Snapshot file. They need to either do a mcrName = "McrUNV" objAccess.DoCmd.RunMacro mcrName or be able to display a Snapshot file. For thoses of you who know DB2 it is very easy from a Web Page, however in asp it is presenting a problem I have no idea how to display a Page with a Snapshot file to be displayed. The objAccess.DoCmd.RunMacro mcrName give us a message of: You can't carry out this action at this time. I have spent four days (I am on leave from the Navy) searching the Web. Some sites say I have to go to Printer Settings and create a file and set my Default Printer to that file. I have no examples to go by and have been guessing for four days. Because I can do this in DB2 (with Assembler Language Sub-Routines I might add) people are requesting me to do it in an asp page as a favor. If someone knows either way I can get this to work (Run a Macro on my Server or show a page with a Sanpshot file) I will owe that individual a lunch. Thanks for trying to help. Len Tag: Writing To Word File Tag: 185196
  - 14
    - Server exists ? Hi, how can I check if a server (given a path ex. \\LAN01 ) exists ? Thanks for help, Versor Tag: Writing To Word File Tag: 185195
  - 15
    - Discover installed browser(s) Is it possible to discover installed browser(s) using vbscript ? Marry Christmas and a Happy New Year Thanks in advance, Robertico Tag: Writing To Word File Tag: 185192
  - 16
    - Run a Macro From an ASP Page I am getting a message: You can't carry out this action at the present time. Here is my code: StrADO = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" StrADO = StrADO & "C:\INetPub\wwwRoot\CBoE\NAmerica.mdb;User ID=;Password=" Set Cnnct = Server.CreateObject("ADODB.Connection") Cnnct.CursorLocation = 3 Cnnct.Open StrADO <% Cnnct.execute "Drop Procedure qryUNV" Cnnct.execute "Create Procedure qryUNV as SELECT " & Subject ", HSARCD, LSCHOOL, Address1, Address2, City, ST, ZipCode FROM DellCity WHERE " & Subject & " Is Not Null And HSARCD = '" & PGAC & "'"%> <%Set objAccess = Server.CreateObject("Access.Application") objAccess.Visible = False Set objDB = objAccess.CurrentDb() mcrName = "mcrName" objAccess.DoCmd.RunMacro mcrName ' Message displayed on this line %> Does anyone know what I am doing wrong or why I am getting the above message. Thanks in advance. Granny Tag: Writing To Word File Tag: 185184
  - 17
    - HTML DropDown Menu and VBSCRIPT I have an html page... I have a vbscript. The vbscript loads when the html page is loaded and populates the HTML box with data. I put an onChange on the selection box to call a sub routine. Based upon the value of the selection box, it is supposed to do something. However, the vbscript doesn't recognize the object (the drop down box)... I know the html page calls the sub routine correctly as I can do a msgbox "a". I specified a name for the drop down menu (name="nameOfDropDown") and in the vbscript I say MsgBox nameOfDropDown.Value I get an error saying, "Object required 'nameOfDropDown' What am I missing? Tag: Writing To Word File Tag: 185183
  - 18
    - Shell object error Hello, I'm trying to copy a folder using the shell object. Here's the code: Const FOF_CREATEPROGRESSDLG = &H0& ParentFolder = "D:\Archive" Set objShell = CreateObject("Shell.Application") Set objFolder = objShell.NameSpace(ParentFolder) objFolder.CopyHere "C:\Scripts", FOF_CREATEPROGRESSDLG I got this from the script ropository. It doesn't work for me. This is the error I get. Line: 11 Char:1 Error: Variable is undefined: 'ParentFolder' Code: 800a01f4 Can anyone get this to work??? Does the target folder need to exist before you copy? Thank you for any help. Tag: Writing To Word File Tag: 185181
  - 19
    - Virtual Path Error 0x80004005 Hey guys and gals I need some help! I get this error on Windows 2000 Professional Server.MapPath(), ASP 0172 (0x80004005) The path parameter for the MapPath method must be a virtual path. A physical path was used. My Code Follows: strDbName = "C:\INetPub\wwwRoot\Unvrsty\STTests.MDB" Set objAccess = Server.CreateObject("Access.Application") objAccess.Visible = False objAccess.OpenCurrentDatabase Server.MapPath(strDbName) ' Error Line I have made sure that the Unvrsty Directory has full priviledges. Thanks for Help in Advance; Len Tag: Writing To Word File Tag: 185180
  - 20
    - A Christmas Present (that you didn't ask for)... This is a multi-part message in MIME format. --------------080603000702030103020107 Content-Type: text/plain; charset=ISO-8859-1; format=flowed Content-Transfer-Encoding: 7bit In the great tradition of (most) Christmas Presents, this is one you didn't ask for, you didn't want, and you will probably never use. It is a status message / progressbar utility. A StatusMsg/ProgBar capability is one of the most serious omissions of wsh/vbs, if not _the_ most serious omission. Every other scripting language (that I know of) does have a StatusMsg/ProgBar capability. As you know, scripters have not stood idly by and accepted this deficiency. There are a great number of StatusMsg/ProgBar utilities already available out there (and most are offered for free). They are usually written in vb, but any competent language could be used. What is unusual about _THIS_ StatusMsg/ProgBar utility is that it is written in script. More specifically, it is written in vbs using api's called by DynaWrap to create the graphical interface. I know what you're thinking -- DynaWrap is a 3rd-party control, and not "pure" script. I would assert that DynaWrap is "almost pure" script. Here's the argument. For one, it comes with code, and so you can reassure yourself that nothing under- handed is going on. For another, the code was originally published in the Microsoft Developer's Journal, and so by implication it bears the imprimature of Microsoft. DynaWrap is no stranger to the scripting ng's. It has been mentioned in the scripting ng's for years (since 1999) and is frequently suggested for use when somebody wishes to do something outside the realm of "pure" script. Finally, it is "lite weight". The dll is only 36kb, and there are no vbRuntimes used. Compared with (bloated) InternetExplorer, which is the usual suggestion here for use as a scripting StatusMsg/ProgBar dialog, DynaWrap is exceedingly "lite weight". Yes, DynaWrap is lacking in features for use with serious heavy-duty api's. Most importantly for gui programming, it is lacking in any typedef capability, and there is no provision for callbacks. With this in mind, a StatusMsg/ ProgBar utility is about as far as one can go with DynaWrap, because it is a "dialog" -- but the dialog is only "one-way" (you are telling the user something, but not allowing him/her to talk back). It is the "talking-back" part that requires callbacks. That is, you need to make provisions for the system send to you notification messages indicating that the user is interacting with your dialog (buttons were clicked, etc). So here it is, for what it's worth. The first attachment is the StatusMsg/ProgBar utility, wrapped up as a scripting component in a "wsc" file. You may regester the wsc and call it from script, or you may also just load it from a local file. Or, if you don't like dealing with components, you can just extract the relevant code and stick it directly into your script. The other attachment is a demo script. The "boilerplate" below describes how to get DynaWrap, just in case you don't have it. cheers, jw --- <DynaWrap Boilerplate> --- It is possible to declare-and-call an api from script, but you must use a third-party control to do so, or else write one yourself. It has already been correctly pointed out that there is no api-capability in "pure" script. If you are willing to use a third-party control, then one such control, called "DynaWrap", can be found on Guenter Born's website (note: Guenter refers to it as "DynaCall"). Here is the link to it: http://people.freenet.de/gborn/WSHBazaar/WSHDynaCall.htm On that page you will find a download for the control, plus some code samples. Note: you may find additional sample code by searching the archives of the wsh and vbscript ng's. Note also: DynaWrap does have its limitations. There are certain things it can't do. For example, you can't call api's which take typedefs as parameters, and you can't call api's "by ordinal". But it will work for most of the "usual suspects". And finally, DynaWrap doesn't work entirely as advertised. For example, it is supposed to allow for the declaration of several api definitions in one instance of itself. I could never get that to work (in win9x). You will need a new instance of DynaWrap for every api, or else re-instantiate the object for every api. Someday I'm going to learn enough c++ to fix that... --- </DynaWrap Boilerplate> --- --------------080603000702030103020107 Content-Type: text/plain; name="StatusMsgProgBarDialog.wsc.txt" Content-Transfer-Encoding: 7bit Content-Disposition: inline; filename="StatusMsgProgBarDialog.wsc.txt" <?xml version="1.0"?> <component> <?component error="true" debug="true"?> <registration description="StatusMsgProgBarDialog" progid="StatusMsgProgBarDialog.WSC" version="1.00" classid="{e3638360-6d72-11da-a061-d0265bc1a60b}" > </registration> <public> <property name="pbBackColor"> <get/> <put/> </property> <property name="pbForeColor"> <get/> <put/> </property> <property name="titlebarCaption"> <get/> <put/> </property> <property name="txtStatusMessage"> <get/> <put/> </property> <property name="iPctComplete"> <get/> <put/> </property> <method name="Create_ProgbarDialog"> <PARAMETER name="sCaption"/> </method> <method name="PostStatusAndPct"> <PARAMETER name="sStatusMsg"/> <PARAMETER name="iPct"/> </method> <method name="CloseDialog"> </method> </public> <script language="VBScript"> <![CDATA[ Option Explicit ' ' --- description block -------------------------- ' Title: A Status Message / Progressbar Utility... ' ' Description: O.K., so there are plenty of these dialogs around, ' but it was in intriguing challenge to program this ' with DynaWrap... ' ' Author: mr_unreliable ' ' Usage: Use at you own risk, tested on win98se... ' ' --- revision history --------------------------- ' 10Dec05: original attempt, using the wshATO "MakeWindow" script as inspiration... ' 11Dec05: couldn't get valid instance handle for THIS script, and so using ' the desktop instance handle, for now. (Maybe inspiration will strike later)... ' 11Dec05: in an attempt to get color into the progbar, used "SetTextColor" but ' that didn't work(?). So, used "DrawText" to draw the text (i.e., the blocks) ' to the textbox, but that apparently draws "on" the box, not "in" the box, ' that is, the image doesn't "persist" (ugh!)... ' 12Dec05: changing approach to using a static control, and inserting a bitmap ' image (i.e., a "rectangle" drawn in to resemble a progbar)... ' 14Dec05: redraw the bitmap "every time" (rather than attempting to retain/modify it)... ' 15Dec05: move the status msg / progbar dialog code to a "wsc" component, ' for the "usual reasons", i.e., "packaging"... ' --- end of description block ------------------- ' ' --- global variables --------------------------- Dim oDW ' as object (instantiated later)... Dim m_hWndDlg, m_hStatic, m_hProgbar ' as long(s) (handles) Dim m_hFontMsg, m_hFontLogo ' as font handle(s) Dim m_hInstance ' as instance handle Dim wdDlg : wdDlg = 440 Dim htDlg : htDlg = 115 Dim wdProgbar, htProgbar ' as long ' Dim hDCProgbar, hDCPBSave ' as long Dim hBmp : hBmp = 0 : Dim hDCMem : hDCMem = 0 ' as handles to system objects Dim hBackPen, hBackBrush ' as long (handles) Dim hBarPen, hBarBrush ' as long (handles) ' Dim pbBackColor : pbBackColor = "&HFFFFFF" ' white Dim pbForeColor : pbForeColor = "&HFF0000" ' blue Dim titlebarCaption : titlebarCaption = " StatusMsg / ProgressBar Dialog " Dim txtStatusMessage: txtStatusMessage = " StatusMsg goes here... " Dim iPctComplete : iPctComplete = 0 ' system constants (oops, can't use constants here -- FOR SHAME MICROSOFT!!!) Dim SW_HIDE : SW_HIDE = 0 ' showwindow constants Dim SW_SHOW : SW_SHOW = 5 Dim FW_NORMAL : FW_NORMAL = 400 ' 100=Light, 400=Normal, 700=Bold, 900=Heavy Dim FW_BOLD : FW_BOLD = 700 ' Dim nRtn ' as long (hold api return value) ' --- End of declarations and constants ---------- Public Function get_pbBackColor() get_pbBackColor = pbBackColor End function Public Function put_pbBackColor(crNew) pbBackColor = crNew End function Public Function get_pbForeColor() get_pbForeColor = pbForeColor End function Public Function put_pbForeColor(crNew) pbForeColor = crNew End function Public Function get_titlebarCaption() get_titlebarCaption = titlebarCaption End function Public Function put_titlebarCaption(sNewCaption) titlebarCaption = sNewCaption ' todo: add code to insert this caption into the titlebar... End function Public Function get_txtStatusMessage() get_txtStatusMessage = txtStatusMessage End function Public Function put_txtStatusMessage(sNewMsg) txtStatusMessage = sNewMsg ' stick the new status message into the static control... Call SetWindowText(m_hStatic, txtStatusMessage) Call UpdateWindow(m_hWndDlg) ' otherwise known as: form.refresh End function Public Function get_iPctComplete() get_iPctComplete = iPctComplete End function Public Function put_iPctComplete(iNewPctComp) iPctComplete = iNewPctComp Call RepaintProgBar(iPctComplete) ' update progbar... Call UpdateWindow(m_hWndDlg) ' otherwise known as: form.refresh End function ' --- CREATE PROGBAR DIALOG ---------------------- Public Function Create_ProgbarDialog(sCaption, pxLeft, pxTop) ' MsgBox(sCaption) Dim hWndDlg, hLogo ' as long(s) handles Dim dwStyle, dwExStyle ' as long ' Const WS_VISIBLE = &H10000000 ' window style bits Const WS_CAPTION = &HC00000 ' WS_BORDER Or WS_DLGFRAME Const WS_POPUP = &H80000000 Const WS_CHILD = &H40000000 ' Const WS_EX_NOPARENTNOTIFY = &H4 Const WS_EX_CLIENTEDGE = &H200 ' Const SS_BITMAP = &H0000000E ' static control style bits ' Const WM_SETFONT = &H30 ' Const PS_SOLID = 0 ' pen style ' Const SWP_NOMOVE = &H2 Const SWP_NOZORDER = &H4 Const SWP_NOSIZE = &H1 Const SWP_SHOWWINDOW = &H40 Const HWND_TOPMOST = -1 ' Dim swpFlags ' as long ' --- end of declarations and constants ---------- titlebarCaption = sCaption ' get an instance handle for THIS instance of wscript (tricky)... m_hInstance = GetInstanceHandle() dwStyle = WS_POPUP Or WS_CAPTION dwExStyle = WS_EX_NOPARENTNOTIFY ' ---------------------------------------------- ' note: typically, one would set up a window class of one's own, so as to ' be able to define the look-and-feel of the window. That is, the icon ' the cursor, the background/text colors, etc. But more importantly, ' you also supply a wndproc address, i.e., a routine to process messages ' coming from the window (i.e., to detect "events"). ' But that requires a typedef, and a wndproc, things that are way ' beyond the capabilities of DynaWrap. And so, we will attempt to ' get by with a "system standard" window class, namely: "#32770"... ' That is the standard "dialog class", and as such there is a "default ' wndproc" built into the system, which will handle the minimal functions ' expected of a window. (Good Luck!)... ' ---------------------------------------------- hWndDlg = CreateWindowEx(0, "#32770", titlebarCaption, dwStyle, _ pxLeft,pxTop, wdDlg,htDlg, 0, 0, m_hInstance, 0) ' was CStr(m_sWndClass) ' ---------------------------------------------- ' add some (child) controls to the window (note: static = label)... m_hStatic = CreateWindowEx(0, "Static", "Script Status Messages go here.. ", _ WS_CHILD Or WS_VISIBLE, 20, 5, wdDlg - 20, 20, hWndDlg, 0, m_hInstance, 0) ' create the "progbar" window (i.e., using a "static" showing a bitmap)... wdProgbar = wdDlg - 25 - 6 : htProgbar = 22 m_hProgbar = CreateWindowEx(WS_EX_CLIENTEDGE, "Static", "", _ WS_CHILD Or WS_VISIBLE Or SS_BITMAP , 10, 35, wdProgbar, htProgbar, hWndDlg, 0, m_hInstance, 0) hLogo = CreateWindowEx(0, "Static", "brought to you by jawar productions (all rights reserved)... ", _ WS_CHILD Or WS_VISIBLE, wdDlg - 290, 75, 380, 25, hWndDlg, 0, m_hInstance, 0) ' (note: should probably go get these colors from sysinfo)... hBackPen = CreatePen(PS_SOLID, 1, pbBackColor) ' C0C0C0) ' msGray hBackBrush = CreateSolidBrush(pbBackColor) ' C0C0C0) ' aka, Silver hBarPen = CreatePen(PS_SOLID, 1, pbForeColor) ' crBlue) hBarBrush = CreateSolidBrush(pbForeColor) ' crBlue) Call RepaintProgBar(0) ' paint in background... ' create fonts (otherwise the default fonts for this system will be used)... m_hFontMsg = GetFontHandle("MS Sans Serif", 10, 0, FW_BOLD, False) m_hFontLogo = GetFontHandle("Arial", 7, 0, FW_NORMAL, True) ' aspect ratio = 0 is default ' now, set prepared fonts into their respective controls. Call SendMessage(m_hStatic, WM_SETFONT, m_hFontMsg, 0) Call SendMessage(hLogo, WM_SETFONT, m_hFontLogo, 0) ' Call ShowWindow(hWndDlg, SW_SHOW) ' show the window here... ' msgbox("ck static") ' show the window here, and attempt to push it to the front... swpFlags = SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE Call SetWindowPos(hWndDlg, HWND_TOPMOST, 0, 0, 0, 0, swpFlags) ' note: this "ought not" to be necessary, but without it the logo ' seems to be reluctant to initially appear (paint itself)??? Call UpdateWindow(hWndDlg) ' otherwise known as: form.refresh Create_ProgbarDialog = hWndDlg ' return value (window handle) End Function ' --- POST STATUS MSG _AND_ PCT COMPLETE --------- Public Function PostStatusAndPct(sNewMsg, iNewPctComp) txtStatusMessage = sNewMsg iPctComplete = iNewPctComp ' stick the new status message into the static control... Call SetWindowText(m_hStatic, txtStatusMessage) Call RepaintProgBar(iPctComplete) ' update progbar... Call UpdateWindow(m_hWndDlg) ' otherwise known as: form.refresh End function ' --- CLOSE DIALOG ------------------------------- Public Function CloseDialog() Call ShowWindow(m_hWndDlg, SW_HIDE) ' hide the window, before messing around... ' nota bene: if you save/restore the COMPLETE device context, then ' you don't need to put the dc back the way it was before exiting... ' clean-up gdi system objects... Call RestoreDC(hDCProgbar, hDCPBSave) ' return progbar DC to original state Call DestroyWindow(m_hWndDlg) ' release "system objects" (we do our bit to help prevent "memory leaks")... Call DeleteObject(hBmp) Call DeleteObject(hBackPen) ' return system object(s) Call DeleteObject(hBackBrush) Call DeleteObject(hBarPen) ' return system object(s) Call DeleteObject(hBarBrush) Call DeleteObject(m_hFontMsg) Call DeleteObject(m_hFontLogo) End Function ' ================================================ ' PRIVATE (INTERNAL) FUNCTIONS, (from here on out) ' ================================================ ' --- REPAINT PROGBAR ---------------------------- Private Function RepaintProgBar(iPct) Const STM_SETIMAGE = &H172 ' winuser.h Const IMAGE_BITMAP = 0 ' ============================================== ' Discussion: dealing with the problem of "persistance". You can get a reference ' to the device context of a static control, set the fore/back colors and then ' draw shapes or text on it, and it looks ok. BUT what is happening is that ' you are drawing on the screen. You can see what you draw, at least when ' you draw it -- but if your window gets hidden and then re-appears that drawing ' will have disappeared. In geek-speak, your image didn't "persist". ' ' In vb, that "persistance" issue is auto-magically taken care of for you. ' VB intercepts any system messages telling you to re-draw the control, and ' does it. However, in this case we are "flying-without-the-net", i.e., we ' are relying on the "default wndproc's" because we can't setup a callback ' wndproc for our window with dynawrap. ' ' And so, we are going to have to take other measures to insure that we get ' "persistance" of the progbar graphics. We are going to use "brute force". ' That is, we are going to make up a "memory bitmap" with the graphics we want, ' and then insert the bitmap into an appropriately-styled static control, ' which will then take over and resolutely display the graphics "come-what-may"... ' ============================================== ' get device context (of the progbar/static control)... hDCProgbar = GetDC(m_hProgbar) ' save existing device context of control, before messing around (DA, pg 490)... hDCPBSave = SaveDC(hDCProgbar) Dim hNewBmp ' create a bitmap (compatible with the display), in memory... hNewBmp = CreateCompatibleBitmap(hDCProgbar, wdProgbar, htProgbar) BugAssert (hNewBmp <> 0), " could not create compatible bitmap" ' then create a "memory device" compatible DC... hDCMem = CreateCompatibleDC(hDCProgbar) BugAssert (hDCMem <> 0), " could not create compatible dc" ' select the new bitmap, pen and brush objects into the (memory) device context... Dim hPrevBmp, hPrevPen, hPrevBrush ' as long hPrevBmp = SelectObject(hDCMem, hNewBmp) hPrevPen = SelectObject(hDCMem, hBackPen) ' select pen into DC... hPrevBrush = SelectObject(hDCMem, hBackBrush) ' clean up (erase) the memory bitmap, by painting in a rectangle with the ' background (msGray) color. This is being done because the progressbar bar ' doesn't initially fill up the static control... ' Windows draws the outline of the figure with the current pen selected, ' and the figure is filled with the current brush selected (CP 558)... nRtn = Rectangle(hDCMem, 0,0, wdProgbar, htProgbar) BugAssert (nRtn <> 0), " .. Rectangle returned an error" ' --- draw in the progbar, if any -------------- If (iPct > 0) then ' change pens (to draw color portion)... hPrevPen = SelectObject(hDCMem, hBarPen) ' select pen into DC... hPrevBrush = SelectObject(hDCMem, hBarBrush) ' calculate the length of the progbar. Let 100pct be (wdProgbar - 2). ' then, the length is iPct/100 * (wdProgbar - 2)... Dim pxProgbar : pxProgbar = iPct/100 * (wdProgbar - 2) nRtn = Rectangle(hDCMem, 2,2, pxProgbar, htProgbar - 1) ' allowance for frame BugAssert (nRtn <> 0), " .. Rectangle returned an error" End If ' test iPct ' --- finished with drawing the progbar -------- ' set bitmap image into the static control... nRtn = SendMessage(m_hProgbar, STM_SETIMAGE, IMAGE_BITMAP, hNewBmp) ' cleanup time... Call SelectObject(hDCMem, hPrevBmp) ' probably not necessary (see RestoreDC) if (hBmp <> 0) then Call DeleteObject(hBmp) ' release old bitmap... hBmp = hNewBmp ' preserve this (new) bitmap, while it's being displayed ' finished drawing, restore device context, release system resources... Call RestoreDC(hDCMem, hDCPBSave) ' note PB DC same as original hDCMem(?) Call DeleteDC(hDCMem) Call ReleaseDC(m_hProgbar, hDCProgbar) ' ============================================== ' Call UpdateWindow(m_hWndDlg) ' otherwise known as: form.refresh End Function ' --- GET INSTANCE HANDLE (of Desktop -- cheat, cheat) --- Private Function GetInstanceHandle() ' Dim hInstance ' Discussion: getting an instance handle with vb is easy, as there is ' an already defined hInstance property of the vbApp object. ' Unfortunately, wscript doesn't provide this, so we will have to ' go get it using "brute force" (i.e., go get it the hard way). ' That involves some tricky-dicky stuff. First, we are going to ' have to find wscript's "hidden window" (yes Dorothy, there _IS_ ' a wscript window -- how do you think wscript communicates with ' the system, eh?). Assuming we can find that hidden window, then ' we can use that go get our hInstance, using gwl_hInstance which ' gets the instance handle for a window... ' --- end of discussion -------------------------- ' get an instance handle (from vbApp object, for now), ' but that's not a "pure" DynaWrap play... ' hInstance = oATO.vbApp.hInstance ' requires wshATO, verboten here... ' More Discussion: had to temporarily give up on getting the hInstance ' for THIS script. Enumming the "thread windows" would have found it ' directly, but that requires a "callback routine" which can't be done in ' script without using something with more capabilities than DynaWrap. ' Another approach would be enumming ALL the desktop windows, which would ' work with DynaWrap, using getDesktop window and then GetNextWindow on ' down the chain, but then, if you have more than one wscript instance ' running, how do you detect which one is yours??? (Maybe comparing ' command lines would work -- if one could guarantee a unique command line)... ' ' And so for now, we will be using the "desktop instance", which is easy ' to get. (Caveat Emptor: if your window uses the wscript instance, then ' the window auto-magically goes away when your script terminates. ' But, if you use the "desktop instance" then you better make sure that ' you kill the window BEFORE you close, or the window is most likely to ' hang around forever). Yes, yes, I know, it's ugly... ' --- end of discussion (part2) ------------------ Dim hDesktop ' as long (handle) Const GWL_HINSTANCE = (-6) Dim hDeskInstance ' as long (handle) hDesktop = GetDesktopWindow() hDeskInstance = GetWindowLong(hDesktop, GWL_HINSTANCE) GetInstanceHandle = hDeskInstance ' hInstance ' return result End Function ' --- GET FONT HANDLE ---------------------------- Private Function GetFontHandle(sFontName, ptSiz, AspectRatio, fntWeight, vItalic) Dim hFont ' as font handle ' font-related constants, (note: the "weight constants defined globally)... ' Const FW_NORMAL = 400 ' 100=Light, 400=Normal, 700=Bold, 900=Heavy ' Const FW_BOLD = 700 ' Const DEFAULT_ASPECTRATIO = 0 Const DEFAULT_CHARSET = 1 Const OUT_DEFAULT_PRECIS = 0 Const CLIP_DEFAULT_PRECIS = 0 Const DEFAULT_QUALITY = 0 Const DEFAULT_PITCH = 0 Const FF_DONTCARE = 0 ' Const LOGPIXELSY = 90 ' Logical pixels/inch in Y ' --- end of declarations and constants ---------- ' Make it negative, so as to apply to "glyph", rather than "cell". ' Dim cf_PtSize : cf_PtSize = - CSng(GetDeviceCaps(GetDC(hWndDlg), LOGPIXELSY) / 72) ' forget the api's for now, just plug it in... Dim cf_PtSize : cf_PtSize = - CSng(96 / 72) ' micron crt logpixelsy = 96 ' --- finished with font conversion factor ----- Dim htFont, wdFont ' as long htFont = Int(ptSiz * cf_PtSize) wdFont = Int((ptSiz * cf_PtSize) * AspectRatio) ' was DEFAULT_ASPECTRATIO ' convert vbScript boolean to system true/false... Dim bItalic ' as system t/f If vItalic then bItalic = 1 ' system true, i.e., want it as italic Else bItalic = 0 ' system false, i.e. not italic (regular) End If hFont = CreateFont(htFont, wdFont, 0, 0, fntWeight, bItalic, _ 0, 0, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, _ DEFAULT_QUALITY, DEFAULT_PITCH Or FF_DONTCARE, sFontName) GetFontHandle = hFont End Function ' ================================================ ' ================================================ ' === "WRAPPERS" FOR API CALLS (DynaWrap style) == ' ' the DynaWrap doc is rather inscrutable, but as best I can make out, ' DynaWrap can only accomodate ONE api declaration at a time. ' (If I'm wrong, maybe you experts can straighten me out on this). ' ' Assuming that my one-at-a-time hypothesis is correct, ' then one has two choices: ' - you need to set up a separate obj for EVERY api (ugh!), or ' - declare the api's to be used (one-at-a-time) as you go, ' which is what you see here (yes, it's "ugly")... ' ---------------------------------------------- ' the DynaWrap parameters are: ' i => the number and data type of the function's parameters ' f => type of call _stdcall or _cdecl. ' (Default to _stdcall. If that doesn't work use _cdecl). ' r => return data type. ' the data type declarations are: ' c => VT_I4: c signed char ' d => VT_R8: d 8 byte real ' f => VT_R4: f 4 byte real ' h => VT_I4: h HANDLE ' l => VT_I4: l long ' p => VT_PTR: p pointer ' s => VT_LPSTR: s string ' t => VT_I2: t short ' u => VT_UINT: u unsigned int ' w => VT_LPWSTR: w wide string ' r => VT_BYREF: (pass by reference) for strings only. ' ' the call type declarations are: ' s => _stdcall (standard vb-type call) ' => _cdecl (c++ type call) ' ---------------------------------------------- ' ================================================ ' ================================================ Private Function CreateWindowEx(dwExStyle, sClassName, sWindowName, dwStyle, dwLeft,dwTop, _ dwWidth,dwHeight, hWndParent, hMenu, hInstance, lpParam) Set oDW = nothing ' clear any previous instance Set oDW = CreateObject("DynamicWrapper") ' start over... ' register (declare) this flavor of api call... oDW.Register "USER32.DLL", "CreateWindowExA", "i=lsslllllllll", "f=s", "r=h" CreateWindowEx = oDW.CreateWindowExA(CLng(dwExStyle), CStr(sClassName), CStr(sWindowName), _ CLng(dwStyle), CLng(dwLeft),CLng(dwTop), CLng(dwWidth),CLng(dwHeight), _ CLng(hWndParent), CLng(hMenu), CLng(hInstance), CLng(lpParam)) End Function ' Declare Function CreatePen Lib "gdi32" Alias "CreatePen" _ ' (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long Private Function CreatePen(nPenStyle, nWidth, crColor) Set oDW = nothing ' clear any previous instance Set oDW = CreateObject("DynamicWrapper") ' start over... ' register (declare) this flavor of api call... oDW.Register "GDI32.DLL", "CreatePen", "i=lll", "f=s", "r=l" CreatePen = oDW.CreatePen(CLng(nPenStyle), CLng(nWidth), CLng(crColor)) End Function ' Declare Function CreateSolidBrush Lib "gdi32" Alias "CreateSolidBrush" _ ' (ByVal crColor As Long) As Long Private Function CreateSolidBrush(crColor) Set oDW = nothing ' clear any previous instance Set oDW = CreateObject("DynamicWrapper") ' start over... ' register (declare) this flavor of api call... oDW.Register "GDI32.DLL", "CreateSolidBrush", "i=l", "f=s", "r=l" CreateSolidBrush = oDW.CreateSolidBrush(CLng(crColor)) End Function ' Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ ' (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Function SendMessage(hWnd, wMsg, wParam, lParam) Set oDW = nothing ' clear any previous instance Set oDW = CreateObject("DynamicWrapper") ' start over... ' register (declare) this flavor of api call... oDW.Register "USER32.DLL", "SendMessageA", "i=llll", "f=s", "r=l" SendMessage = oDW.SendMessageA(CLng(hWnd), CLng(wMsg), CLng(wParam), CLng(lParam)) End Function ' Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" _ ' (ByVal hWnd As Long, ByVal lpString As String) As Long Private Function SetWindowText(hWnd, lpString) Set oDW = nothing ' clear any previous instance Set oDW = CreateObject("DynamicWrapper") ' start over... ' register (declare) this flavor of api call... oDW.Register "USER32.DLL", "SetWindowText", "i=ls", "f=s", "r=l" SetWindowText = oDW.SetWindowText(CLng(hWnd), CStr(lpString)) End Function ' Declare Function ShowWindow Lib "user32" Alias "ShowWindow" _ ' (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long Private Function ShowWindow(hWnd, nCmdShow) Set oDW = nothing ' clear any previous instance Set oDW = CreateObject("DynamicWrapper") ' start over... ' register (declare) this flavor of api call... oDW.Register "USER32.DLL", "ShowWindow", "i=ll", "f=s", "r=l" ShowWindow = oDW.ShowWindow(CLng(hWnd), CLng(nCmdShow)) End Function ' Declare Function SetWindowPos Lib "user32" Alias "SetWindowPos" _ ' (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 Function SetWindowPos(hWnd, hWndInsertAfter, x,y, cx,cy, wFlags) Set oDW = nothing ' clear any previous instance Set oDW = CreateObject("DynamicWrapper") ' start over... ' register (declare) this flavor of api call... oDW.Register "USER32.DLL", "SetWindowPos", "i=lllllll", "f=s", "r=l" SetWindowPos = oDW.SetWindowPos(CLng(hWnd), CLng(hWndInsertAfter), _ CLng(x), CLng(y), CLng(cx), CLng(cy), CLng(wFlags)) End Function ' Declare Function UpdateWindow Lib "user32" Alias "UpdateWindow" _ ' (ByVal hWnd As Long) As Long Private Function UpdateWindow(hWnd) Set oDW = nothing ' clear any previous instance Set oDW = CreateObject("DynamicWrapper") ' start over... ' register (declare) this flavor of api call... oDW.Register "USER32.DLL", "UpdateWindow", "i=l", "f=s", "r=l" UpdateWindow = oDW.UpdateWindow(CLng(hWnd)) End Function ' Declare Function DeleteObject Lib "gdi32" Alias "DeleteObject" _ ' (ByVal hObject As Long) As Long Function DeleteObject(hObject) Set oDW = nothing ' clear any previous instance Set oDW = CreateObject("DynamicWrapper") ' start over... ' register (declare) this flavor of api call... oDW.Register "GDI32.DLL", "DeleteObject", "i=l", "f=s", "r=l" DeleteObject = oDW.DeleteObject(CLng(hObject)) End Function ' Declare Function DestroyWindow Lib "user32" Alias "DestroyWindow" _ ' (ByVal hWnd As Long) As Long Function DestroyWindow(hWnd) Set oDW = nothing ' clear any previous instance Set oDW = CreateObject("DynamicWrapper") ' start over... ' register (declare) this flavor of api call... oDW.Register "USER32.DLL", "DestroyWindow", "i=l", "f=s", "r=l" DestroyWindow = oDW.DestroyWindow(CLng(hWnd)) End Function ' Declare Function GetDesktopWindow Lib "user32" Alias "GetDesktopWindow" () As Long Private Function GetDesktopWindow() Set oDW = nothing ' clear any previous instance Set oDW = CreateObject("DynamicWrapper") ' start over... ' register (declare) this flavor of api call... oDW.Register "USER32.DLL", "GetDesktopWindow", "f=s", "r=h" ' no inputs GetDesktopWindow = oDW.GetDesktopWindow() End Function Private Function GetWindowLong(hWnd, nIndex) Set oDW = nothing ' clear any previous instance Set oDW = CreateObject("DynamicWrapper") ' start over... ' register (declare) this flavor of api call... oDW.Register "USER32.DLL", "GetWindowLong", "i=ll", "f=s", "r=l" GetWindowLong = oDW.GetWindowLong(CLng(hWnd), CLng(nIndex)) End Function ' Declare Function GetDC Lib "user32" Alias "GetDC" (ByVal hWnd As Long) As Long Private Function GetDC(hWnd) Set oDW = nothing ' clear any previous instance Set oDW = CreateObject("DynamicWrapper") ' start over... ' register (declare) this flavor of api call... oDW.Register "USER32.DLL", "GetDC", "i=l", "f=s", "r=l" GetDC = oDW.GetDC(CLng(hWnd)) End Function ' Declare Function SaveDC Lib "gdi32" Alias "SaveDC" (ByVal hDC As Long) As Long Private Function SaveDC(hDC) Set oDW = nothing ' clear any previous instance Set oDW = CreateObject("DynamicWrapper") ' start over... ' register (declare) this flavor of api call... oDW.Register "GDI32.DLL", "SaveDC", "i=l", "f=s", "r=l" SaveDC = oDW.SaveDC(CLng(hDC)) End Function ' Declare Function CreateCompatibleBitmap Lib "gdi32" Alias "CreateCompatibleBitmap" _ ' (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long Private Function CreateCompatibleBitmap(hDC, nWidth, nHeight) Set oDW = nothing ' clear any previous instance Set oDW = CreateObject("DynamicWrapper") ' start over... ' register (declare) this flavor of api call... oDW.Register "GDI32.DLL", "CreateCompatibleBitmap", "i=lll", "f=s", "r=h" CreateCompatibleBitmap = oDW.CreateCompatibleBitmap(CLng(hDC), CLng(nWidth), CLng(nHeight)) End Function ' Declare Function CreateCompatibleDC Lib "gdi32" Alias "CreateCompatibleDC" _ ' (ByVal hDC As Long) As Long Private Function CreateCompatibleDC(hDC) Set oDW = nothing ' clear any previous instance Set oDW = CreateObject("DynamicWrapper") ' start over... ' register (declare) this flavor of api call... oDW.Register "GDI32.DLL", "CreateCompatibleDC", "i=l", "f=s", "r=l" CreateCompatibleDC = oDW.CreateCompatibleDC(CLng(hDC)) End Function ' Declare Function CreatePen Lib "gdi32" Alias "CreatePen" _ ' (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long Private Function CreatePen(nPenStyle, nWidth, crColor) Set oDW = nothing ' clear any previous instance Set oDW = CreateObject("DynamicWrapper") ' start over... ' register (declare) this flavor of api call... oDW.Register "GDI32.DLL", "CreatePen", "i=lll", "f=s", "r=l" CreatePen = oDW.CreatePen(CLng(nPenStyle), CLng(nWidth), CLng(crColor)) End Function ' Declare Function CreateSolidBrush Lib "gdi32" Alias "CreateSolidBrush" _ ' (ByVal crColor As Long) As Long Private Function CreateSolidBrush(crColor) Set oDW = nothing ' clear any previous instance Set oDW = CreateObject("DynamicWrapper") ' start over... ' register (declare) this flavor of api call... oDW.Register "GDI32.DLL", "CreateSolidBrush", "i=l", "f=s", "r=l" CreateSolidBrush = oDW.CreateSolidBrush(CLng(crColor)) End Function ' Declare Function SelectObject Lib "gdi32" Alias "SelectObject" _ ' (ByVal hDC As Long, ByVal hObject As Long) As Long Private Function SelectObject(hDC, hObject) Set oDW = nothing ' clear any previous instance Set oDW = CreateObject("DynamicWrapper") ' start over... ' register (declare) this flavor of api call... oDW.Register "GDI32.DLL", "SelectObject", "i=ll", "f=s", "r=l" SelectObject = oDW.SelectObject(CLng(hDC), CLng(hObject)) End Function ' Declare Function Rectangle Lib "gdi32" Alias "Rectangle" _ ' (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, _ ' ByVal X2 As Long, ByVal Y2 As Long) As Long Private Function Rectangle(hDC, X1,Y1, X2,Y2) Set oDW = nothing ' clear any previous instance Set oDW = CreateObject("DynamicWrapper") ' start over... ' register (declare) this flavor of api call... oDW.Register "GDI32.DLL", "Rectangle", "i=lllll", "f=s", "r=l" Rectangle = oDW.Rectangle(CLng(hDC), CLng(X1), CLng(Y1), CLng(X2), CLng(Y2)) End Function ' Declare Function ReleaseDC Lib "user32" Alias "ReleaseDC" _ ' (ByVal hWnd As Long, ByVal hDC As Long) As Long Private Function ReleaseDC(hWnd, hDC) Set oDW = nothing ' clear any previous instance Set oDW = CreateObject("DynamicWrapper") ' start over... ' register (declare) this flavor of api call... oDW.Register "USER32.DLL", "ReleaseDC", "i=ll", "f=s", "r=l" ReleaseDC = oDW.ReleaseDC(CLng(hWnd), CLng(hDC)) End Function ' Declare Function DeleteDC Lib "gdi32" Alias "DeleteDC" (ByVal hDC As Long) As Long Private Function DeleteDC(hDC) Set oDW = nothing ' clear any previous instance Set oDW = CreateObject("DynamicWrapper") ' start over... ' register (declare) this flavor of api call... oDW.Register "GDI32.DLL", "DeleteDC", "i=l", "f=s", "r=l" DeleteDC = oDW.DeleteDC(CLng(hDC)) End Function ' Declare Function RestoreDC Lib "gdi32" Alias "RestoreDC" _ ' (ByVal hDC As Long, ByVal nSavedDC As Long) As Long Private Function RestoreDC(hDC, nSavedDC) Set oDW = nothing ' clear any previous instance Set oDW = CreateObject("DynamicWrapper") ' start over... ' register (declare) this flavor of api call... oDW.Register "GDI32.DLL", "RestoreDC", "i=ll", "f=s", "r=l" RestoreDC = oDW.RestoreDC(CLng(hDC), CLng(nSavedDC)) End Function ' Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" _ ' (ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, _ ' ByVal W As Long, ByVal I As Long, ByVal u As Long, ByVal S As Long, _ ' ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, _ ' ByVal PAF As Long, ByVal F As String) As Long Private Function CreateFont(Ht, Wd, Es, Ox, Wt, It, Ul, St, Cs, Op, Cp, Q, PAF, sFontName) Set oDW = nothing ' clear any previous instance Set oDW = CreateObject("DynamicWrapper") ' start over... ' register (declare) this flavor of api call... oDW.Register "GDI32.DLL", "CreateFontA", "i=llllllllllllls", "f=s", "r=h" CreateFont = oDW.CreateFontA(CLng(Ht), CLng(Wd), CLng(Es), CLng(Ox), _ CLng(Wt), CLng(It), CLng(Ul), CLng(St), CLng(Cs), CLng(Op), CLng(Cp), _ CLng(Q), CLng(PAF), CStr(sFontName)) End Function Private Sub BugAssert (bTest, sErrMsg) Dim sDblSpace : sDblSpace = vbCrLf & vbCrLf ' BugAssert is a Bruce McKinney creation. ' It is used to test for intermediate results... if bTest then Exit Sub ' normally (hopefully) test returns true... MsgBox "Error Message reported by BugAssert: " & sDblSpace _ & sErrMsg & sDblSpace & " this script will terminate NOW. ", _ vbCritical, " << BugAssert FAILED in Script: " & Wscript.ScriptName & " >> " WScript.Quit End Sub ]]> </script> </component> --------------080603000702030103020107 Content-Type: text/plain; name="wshStatusMsgProgBarDemoScript.vbs.txt" Content-Transfer-Encoding: 7bit Content-Disposition: inline; filename="wshStatusMsgProgBarDemoScript.vbs.txt" ' make an api window using DynaWrap, jw 10Dec05 Option Explicit ' ' --- description block -------------------------- ' Title: A Status Message / Progressbar Utility... ' ' Description: O.K., so there are plenty of these dialogs around, ' but it was in intriguing challenge to program this ' with DynaWrap... ' ' Author: mr_unreliable ' ' Usage: Use at you own risk, tested on win98se... ' ' --- revision history --------------------------- ' 10Dec05: original attempt, using the wshATO "MakeWindow" script as inspiration... ' 11Dec05: couldn't get valid instance handle for THIS script, and so using ' the desktop instance handle, for now. (Maybe inspiration will strike later)... ' 11Dec05: in an attempt to get color into the progbar, used "SetTextColor" but ' that didn't work(?). So, used "DrawText" to draw the text (i.e., the blocks) ' to the textbox, but that apparently draws "on" the box, not "in" the box, ' that is, the image doesn't "persist" (ugh!)... ' 12Dec05: changing approach to using a static control, and inserting a bitmap ' image (i.e., a "rectangle" drawn in to resemble a progbar)... ' 14Dec05: redraw the bitmap "every time" (rather than attempting to retain/modify it)... ' 15Dec05: move the status msg / progbar dialog code to a "wsc" component, ' for the "usual reasons", i.e., "packaging"... ' --- end of description block ------------------- ' ' instantiate ActX components here... Dim oDlg : Call Instantiate_LocalWSC(oDlg, "StatusMsgProgBarDialog.wsc", "") ' no events ' ' --- module level variables --------------------- Const m_sCaption = " << A StatusMsg / Progressbar Dialog (made with dynawrap api calls).. >> " Const sGoodby = "Good-bye folks, and thanks for watching the show... " ' Dim iPct, iBye ' as long Dim sStatusMsg ' as string ' Const tDoEvents = 300 ' 100 ' Dim crBlue : crBlue = RGB(0, 0, &HFF) Dim crGreen: crGreen= RGB(0, &H80, &H80) ' dk cyan (a.k.a. "teal") Dim crGrey : crGrey = RGB(&HE0, &HE0, &HE0) ' (lt grey) ' --- end of declarations and constants ---------- ' ---------------------------------------------- ' Note: this script is using a Progbar Dialog, (created with DynaWrap)... ' ---------------------------------------------- oDlg.pbBackColor = crGrey oDlg.pbForeColor = crGreen ' crBlue Call oDlg.Create_ProgbarDialog(m_sCaption, 150,150) ' ---------------------------------------------- ' Demo Loop, moving along two pct per loop, to speed things up a bit... ' ---------------------------------------------- For iPct = 2 to 100 step 2 WScript.Sleep tDoEvents ' prepare "status message" text... sStatusMsg = "Current Status: Script Processing is " & CStr(iPct) & "% complete." ' oDlg.txtStatusMessage = sStatusMsg ' set statusmsg only ' oDlg.iPctComplete = iPct ' set pct only oDlg.PostStatusAndPct sStatusMsg, iPct ' update status msg and progbar pct... Next ' iPct MsgBox " ..when ready to close the progbar dialog, click OK. ", vbInformation, _ " < Pause Here to Review and Admire the Progbar Dialog Results > " ' say good-bye to all the good folks out there, ' (reset the statusmsg one last time, and "flash" it)... For iBye = 1 to 5 oDlg.txtStatusMessage = sGoodby WScript.Sleep 500 oDlg.txtStatusMessage = "" WScript.Sleep 200 Next ' iBye oDlg.CloseDialog ' (and clean up system resources) Set oDlg = nothing WScript.Quit ' ------------------------------------------------ ' --- Get Local Directory (of this script) ------- ' ------------------------------------------------ ' ' Note: when fso has been instantiated, then use this: ' GetLocalDirectory = fso.GetFile(WScript.ScriptFullName).ParentFolder ' ' --- other suggestions found in the wsh ng, (mikHar)... ' set shell = createobject("wscript.shell") ' appropriate for wsh 5.6 ' currentDirectory = shell.currentdirectory ' (note: not necessarily OF THIS SCRIPT) ' set fso = createobject("scripting.filesystemobject") ' for wsh 5.5 ' currentDirectory = fso.getabsolutepathname(".") ' can't find this one documented(?) ' --- end of other suggestions ------------------- ' ' (however, if fso or oShell are NOT instantiated, use the following code, ' it's more efficient as there are NO additional ole instantiations ' required, with all that ugly and slow "late-binding")... ' Function GetLocalDirectory() Const sMe = "[GetLocalDirectory], " Dim iFile ' as integer ' find the LAST backslash... iFile = InStrRev(Wscript.ScriptFullName, "\") BugAssert (iFile > 0), sMe & " file path problem " ' if backslash not found... ' get the path to this script... GetLocalDirectory = Left(Wscript.ScriptFullName, iFile) ' path (inc "\")... End Function ' getLocalDirectory ' ================================================ ' === INSTANTIATE AN UNREGISTERED WSC COMPONENT == ' ================================================ ' (Note: this technique was suggested by Mike Harris (mvp - scripting), ' see news://microsoft.public.scripting.vbscript, entitled: "wsf vs wsc", ' and timestamped: 2002-03-26 19:10:05 PST). ' ' suggested syntax: ' ' set obj = getobject("script:component path#component id") ' ' where component path can be: ' c:\mypath\mywsc.wsc ' _or_ \\server\share\mypath\mywsc.wsc ' _or_ http://server/mysite/mypath/mywsc.wsc ' ' and, #component id is optional. ' You get the 1st component in the WSC by default. ' You only need #component id if there is more than one in the WSC, ' and you want some other component than the first... ' ' A more exhaustive discussion can be found in the Windows Script Component ' documentation, at the bottom of the page entitled: ' "Using a Script Component in an Application" ' --- end of discussion -------------------------- Sub Instantiate_LocalWSC(oWSC, sComponentFileName, sEventPrefix) ' get the path to the local directory... Dim sLocalDir : sLocalDir = GetLocalDirectory() Dim sComponentPath : sComponentPath = sLocalDir & sComponentFileName ' MsgBox(sComponentPath) ' go get the (wsc) object... ' Set oWSC = WScript.GetObject("script:" & sComponentPath,, sEventPrefix) ' uh-oh. It appears that this approach only works with the VBS getobject ' and not the wscript.getobject flavor. Set oWSC = GetObject("script:" & sComponentPath) ' (step two:) connect the events, (after making sure you need it)... if (sEventPrefix <> "") then WScript.ConnectObject oWSC, sEventPrefix End Sub ' Instantiate_LocalWSC ' --- INSTANTIATE ACTX OBJECT (or class) AND CHECK ---- ' (using a sub to get this ugly instantiation code out of main line code)... Sub Instantiate (oObject, sProgramID, sEventPrefix) Const sME = "[sub Instantiate], " ' check variant sub-type parameters... BugAssert (VarType(sProgramID) = vbString), sME & "sProgramID must be a STRING!" BugAssert (VarType(sEventPrefix) = vbString), sME & "sEventPrefix must be a STRING!" On Error Resume Next ' turn on error checking Set oObject = WScript.CreateObject(sProgramID, sEventPrefix) BugAssert (err.number = 0), sME & "This script requires: " & sProgramID & vbCrlf _ & " kindly INSTALL and REGISTER this ActX component... " On Error goto 0 ' turn off error checking... End Sub ' --- BUGASSERT (yes, it's for debugging) -------- Sub BugAssert (bTest, sErrMsg) Dim sDblSpace : sDblSpace = vbCrLf & vbCrLf ' BugAssert is a Bruce McKinney creation. ' It is used to test for intermediate results... if bTest then Exit Sub ' normally (hopefully) test returns true... MsgBox "Error Message reported by BugAssert: " & sDblSpace _ & sErrMsg & sDblSpace & " this script will terminate NOW. ", _ vbCritical, " << BugAssert FAILED in Script: " & Wscript.ScriptName & " >> " WScript.Quit End Sub --------------080603000702030103020107-- Tag: Writing To Word File Tag: 185175
  - 21
    - getting information how can i get hardware information of a printer on a particular server,with only server name as the input? cheers, nuti Tag: Writing To Word File Tag: 185163
  - 22
    - Enumerating through shares and listing out permissions I am looking for examples of enumerating through the network shares on a machine(XP/2003) and saving the share name, users/groups, and the permissions to a audit file. Does anyone know how to do this or where examples can be found? I guess I would like to add that any places that have common audit tasks that are scripted in vbscript or something similiar for Windows systems would be interesting as well. Thanks. -- bscgmcc Tag: Writing To Word File Tag: 185151
  - 23
    - Enabling windows messenging service? Since XP SP2 came out, messenger service was disabled on workstations. Is there some way within a script to enable the service and start the service? I can imagine a way to start and stop the service if it is enabled, but not disabled. I know very, very little about scripting. If there is a way to do this, it would be great because it would allow me to make it part of our agency's logon script(s) so that we could use mass NET SENDs again for administrative purposes on our LANs. Tag: Writing To Word File Tag: 185150
  - 24
    - T Lavedas' WSH Scripts I am using T Lavedas' WSH Scripts for msgbox function. It takes more than a few seconds for the "msgbox" to appear. Is there any way to speed it up? Thanks, dra Tag: Writing To Word File Tag: 185148
  - 25
    - Trying to get the username of the person logged in on a remote machine. Here is the code that I have attached to a button on an Access 2000 form. I can get information such as the IP Address, Processor, RAM, etc. However, when I try to retrieve the logged in user, it returns nothing. Unless the person is an administrator on the machine. Can any one help with this? strsystem = UnitName.Value Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strsystem & "\root\cimv2") Set loggeduser = objWMIService.ExecQuery("select Username from Win32_ComputerSystem") For Each logged In loggeduser struser = logged.Username Next Username.Value = Mid(struser, 9) Tag: Writing To Word File Tag: 185147

Can someone tell me how to write to a word file in vbscript. I can
create the object, but can't find the syntax to write or format the text.

Any help or direction would be great.

Thanks,

Stan

Top