COM+简单示例(03)

本篇文章介绍了如何写一个简单的COM+客户端(VBS)。

1、testCOMP.vbs

'发生错误时,继续运行
On Error Resume Next

'清除错误状态
Err.Clear

Set Obj=CreateObject("CSCOMTest.JustATestCOM")

'输出错误信息
If Err.Number <> 0 Then
    WScript.Echo "Error: " & Err.Number
    WScript.Echo "Error (Hex): " & Hex(Err.Number)
    WScript.Echo "Source: " &  Err.Source
    WScript.Echo "Description: " &  Err.Description
    'Err.Clear
    '退出程序
    WScript.Quit(Err.Number)
End If

'On Error Goto 0

WScript.Echo obj.Add(1,2)
WScript.Echo obj.SayHiTo("dcom")


set obj=Nothing

2、运行

cscript testCOMP.vbs

3、如果是本机测试(带IP),一般不会遇到权限问题

PS:
用了一晚上时间,只能调通Win7与Win7之间远程调用,无法调通Win7与XP之间远程调用(总是各种提示Access is Denied)。
如果有谁调通过,麻烦留言告诉我一下。谢谢!

DCOM简单示例(03)

本篇文章介绍了如何写一个简单的DCOM客户端(VBS)。

1、testDCOM.vbs

'发生错误时,继续运行
On Error Resume Next

'清除错误状态
Err.Clear

'本地调用
'Set Obj=CreateObject("ATLExe.JustATestExe")
'Set Obj=CreateObject("ATLExe.JustATestExe.1")
'远程调用
Set Obj=CreateObject("ATLExe.JustATestExe","127.0.0.1")
'Set Obj=CreateObject("ATLExe.JustATestExe.1","127.0.0.1")

'输出错误信息
If Err.Number <> 0 Then
    WScript.Echo "Error: " & Err.Number
    WScript.Echo "Error (Hex): " & Hex(Err.Number)
    WScript.Echo "Source: " &  Err.Source
    WScript.Echo "Description: " &  Err.Description
    'Err.Clear
    '退出程序
    WScript.Quit(Err.Number)
End If

'On Error Goto 0

WScript.Echo obj.Add(1,2)
WScript.Echo obj.SayHiTo("dcom")

set obj=Nothing

2、运行

cscript testDCOM.vbs

3、如果是本机测试,一般不会遇到权限问题,但如果是远程测试的话,要先进行配置的,我之前写过这样的文章,打开可以参考一下。

PPT2ANY转换工具

PPT2ANY.vbs

Option Explicit

PPT2ANY "PATH_TO_INFILE\NEOHOPE.COM.IN.pptx","PATH_TO_INFILE\NEOHOPE.COM.OUT.pdf","PDF"
PPT2ANY "PATH_TO_INFILE\NEOHOPE.COM.IN.pptx","PATH_TO_INFILE\NEOHOPE.COM.OUT.png","PNG"

Sub PPT2ANY( inFile, outFile, outFormat)
	Dim objFSO, objPPT, objPresentation, pptFormat

	Const ppSaveAsAddIn                             =8
	Const ppSaveAsBMP                               =19
	Const ppSaveAsDefault                           =11
	Const ppSaveAsEMF                               =23
	Const ppSaveAsExternalConverter                 =64000
	Const ppSaveAsGIF                               =16
	Const ppSaveAsJPG                               =17
	Const ppSaveAsMetaFile                          =15
	Const ppSaveAsMP4                               =39
	Const ppSaveAsOpenDocumentPresentation          =35
	Const ppSaveAsOpenXMLAddin                      =30
	Const ppSaveAsOpenXMLPicturePresentation        =36
	Const ppSaveAsOpenXMLPresentation               =24
	Const ppSaveAsOpenXMLPresentationMacroEnabled   =25
	Const ppSaveAsOpenXMLShow                       =28
	Const ppSaveAsOpenXMLShowMacroEnabled           =29
	Const ppSaveAsOpenXMLTemplate                   =26
	Const ppSaveAsOpenXMLTemplateMacroEnabled       =27
	Const ppSaveAsOpenXMLTheme                      =31
	Const ppSaveAsPDF                               =32
	Const ppSaveAsPNG                               =18
	Const ppSaveAsPresentation                      =1
	Const ppSaveAsRTF                               =6
	Const ppSaveAsShow                              =7
	Const ppSaveAsStrictOpenXMLPresentation         =38
	Const ppSaveAsTemplate                          =5
	Const ppSaveAsTIF                               =21
	Const ppSaveAsWMV                               =37
	Const ppSaveAsXMLPresentation                   =34
	Const ppSaveAsXPS                               =33

	' Create a File System object
	Set objFSO = CreateObject( "Scripting.FileSystemObject" )

	' Create a PowerPoint object
	Set objPPT = CreateObject( "PowerPoint.Application" )

	With objPPT
		' True: make PowerPoint visible; False: invisible
		.Visible = True
 
		' Check if the PowerPoint document exists
		If not( objFSO.FileExists( inFile ) ) Then
			WScript.Echo "FILE OPEN ERROR: The file does not exist" & vbCrLf
			' Close PowerPoint
			.Quit
			Exit Sub
		End If
 
		' Open the PowerPoint document
		.Presentations.Open inFile
 
		' Make the opened file the active document
		Set objPresentation = .ActivePresentation
 
		If StrComp(Ucase( outFormat ),"PDF") = 0 then
			pptFormat = ppSaveAsPDF 
		ElseIf StrComp(Ucase( outFormat ),"XPS") = 0 then
			pptFormat = ppSaveAsXPS
		ElseIf StrComp(Ucase( outFormat ),"BMP") = 0 then
			pptFormat= ppSaveAsBMP
		ElseIf StrComp(Ucase( outFormat ),"PNG") = 0 then
			pptFormat= ppSaveAsPNG
		ElseIf StrComp(Ucase( outFormat ),"JPG") = 0 then
			pptFormat= ppSaveAsJPG
		ElseIf StrComp(Ucase( outFormat ),"GIF") = 0 then
			pptFormat= ppSaveAsGIF
		ElseIf StrComp(Ucase( outFormat ),"XML") = 0 then
			pptFormat= ppSaveAsOpenXMLPresentation
		ElseIf StrComp(Ucase( outFormat ),"RTF") = 0 then
			pptFormat= ppSaveAsRTF
		Else
			WScript.Echo "FILE FORTMART ERROR: Unknown file format" & vbCrLf
			' Close PowerPoint
			.Quit
			Exit Sub
		End If

		' Save in PDF/XPS format
		objPresentation.SaveAs outFile, pptFormat
 
		' Close the active document
		objPresentation.Close
 
		' Close PowerPoint
		.Quit
	End With
End Sub

Excel2ANY转换工具

Excel2ANY.vbs

Option Explicit

Excel2ANY "PATH_TO_INFILE\NEOHOPE.COM.IN.xlsx","PATH_TO_OUTFILE\NEOHOPE.COM.OUT.pdf","PDF"
Excel2ANY "PATH_TO_INFILE\NEOHOPE.COM.IN.xlsx","PATH_TO_OUTFILE\NEOHOPE.COM.OUT.xps","XPS"
Excel2ANY "PATH_TO_INFILE\NEOHOPE.COM.IN.xlsx","PATH_TO_OUTFILE\NEOHOPE.COM.OUT.csv","CSV"

Private Sub Excel2ANY(inFile, outFile, outFormat)
	Dim objFSO, objExcel, objWorkbook, objSheet, xlFormat, isSaveAs

	Const xlAddIn                           =18
	Const xlAddIn8                          =18
	Const xlCSV                             =6
	Const xlCSVMac                          =22
	Const xlCSVMSDOS                        =24
	Const xlCSVWindows                      =23
	Const xlCurrentPlatformText             =-4158
	Const xlDBF2                            =7
	Const xlDBF3                            =8
	Const xlDBF4                            =11
	Const xlDIF                             =9
	Const xlExcel12                         =50
	Const xlExcel2                          =16
	Const xlExcel2FarEast                   =27
	Const xlExcel3                          =29
	Const xlExcel4                          =33
	Const xlExcel4Workbook                  =35
	Const xlExcel5                          =39
	Const xlExcel7                          =39
	Const xlExcel8                          =56
	Const xlExcel9795                       =43
	Const xlHtml                            =44
	Const xlIntlAddIn                       =26
	Const xlIntlMacro                       =25
	Const xlOpenDocumentSpreadsheet         =60
	Const xlOpenXMLAddIn                    =55
	Const xlOpenXMLStrictWorkbook           =61 
	Const xlOpenXMLTemplate                 =54
	Const xlOpenXMLTemplateMacroEnabled     =53
	Const xlOpenXMLWorkbook                 =51
	Const xlOpenXMLWorkbookMacroEnabled     =52
	Const xlSYLK                            =2
	Const xlTemplate                        =17
	Const xlTemplate8                       =17
	Const xlTextMac                         =19
	Const xlTextMSDOS                       =21
	Const xlTextPrinter                     =36
	Const xlTextWindows                     =20
	Const xlUnicodeText                     =42
	Const xlWebArchive                      =45
	Const xlWJ2WD1                          =14
	Const xlWJ3                             =40
	Const xlWJ3FJ3                          =41
	Const xlWK1                             =5
	Const xlWK1ALL                          =31
	Const xlWK1FMT                          =30
	Const xlWK3                             =15
	Const xlWK3FM3                          =32
	Const xlWK4                             =38
	Const xlWKS                             =4
	Const xlWorkbookDefault                 =51
	Const xlWorkbookNormal                  =-4143
	Const xlWorks2FarEast                   =28
	Const xlWQ1                             =34
	Const xlXMLSpreadsheet                  =46
	Const XlFixedFormatType_xlTypePDF       =0
	Const XlFixedFormatType_xlTypeXPS       =1

	' Create a File System object
	Set objFSO = CreateObject( "Scripting.FileSystemObject" )

	' Create a Excell object
	Set objExcel = CreateObject("Excel.Application")

	With objExcel
		' True: make Excell visible; False: invisible
		.Visible = True
 
		' Check if the Excell document exists
		If not( objFSO.FileExists( inFile ) ) Then
			WScript.Echo "FILE OPEN ERROR: The file does not exist" & vbCrLf
			' Close Excell
			.Quit
			Exit Sub
		End If
 
		' Open the Excell document
		.Workbooks.Open inFile
 
		' Make the opened file the active document
		Set objWorkbook = .ActiveWorkbook
		Set objSheet = .ActiveSheet

 		isSaveAs = True
		If StrComp(Ucase( outFormat ),"PDF") = 0 then
			isSaveAs = False
		ElseIf StrComp(Ucase( outFormat ),"XPS") = 0 then
			isSaveAs = False
		ElseIf StrComp(Ucase( outFormat ),"CSV") = 0 then
			xlFormat= xlCSV
		ElseIf StrComp(Ucase( outFormat ),"HTML") = 0 then
			xlFormat= xlHtml
		ElseIf StrComp(Ucase( outFormat ),"XML") = 0 then
			xlFormat= xlXMLSpreadsheet
		ElseIf StrComp(Ucase( outFormat ),"TXT") = 0 then
			xlFormat= xlTextWindows
		Else
			WScript.Echo "FILE FORTMART ERROR: Unknown file format" & vbCrLf
			' Close Excell
			.Quit
			Exit Sub
		End If

		' Save in PDF/XPS format
		If isSaveAs then
			objSheet.SaveAs outFile, xlFormat
		ElseIf StrComp(Ucase( outFormat ),"PDF") = 0 then
			objSheet.ExportAsFixedFormat XlFixedFormatType_xlTypePDF, outFile
		ElseIf StrComp(Ucase( outFormat ),"XPS") = 0 then
			objSheet.ExportAsFixedFormat XlFixedFormatType_xlTypeXPS, outFile
		End If
 
		' Close the active document
		objWorkbook.Close
 
		' Close Excell
		.Quit
	End With
End Sub

Word2ANY转换工具

Word2ANY.vbs

Option Explicit

Word2ANY "PATH_TO_INFILE\NEOHOPE.COM.IN.docx","PATH_TO_OUTFILE\NEOHOPE.COM.OUT.xps","XPS"
Word2ANY "PATH_TO_INFILE\NEOHOPE.COM.IN.docx","PATH_TO_OUTFILE\NEOHOPE.COM.OUT.PDF","PDF"
Word2ANY "PATH_TO_INFILE\NEOHOPE.COM.IN.docx","PATH_TO_OUTFILE\NEOHOPE.COM.OUT.HTML","HTML"
Word2ANY "PATH_TO_INFILE\NEOHOPE.COM.IN.docx","PATH_TO_OUTFILE\NEOHOPE.COM.OUT.XML","XML"
Word2ANY "PATH_TO_INFILE\NEOHOPE.COM.IN.docx","PATH_TO_OUTFILE\NEOHOPE.COM.OUT.RTF","RTF"
Word2ANY "PATH_TO_INFILE\NEOHOPE.COM.IN.docx","PATH_TO_OUTFILE\NEOHOPE.COM.OUT.TXT","TEXT"

Sub Word2ANY( inFile, outFile, outFormat)
	Dim objFSO, objWord, objDoc, wdFormat

	Const wdFormatDocument                    =  0
	Const wdFormatDocument97                  =  0
	Const wdFormatDocumentDefault             = 16
	Const wdFormatDOSText                     =  4
	Const wdFormatDOSTextLineBreaks           =  5
	Const wdFormatEncodedText                 =  7
	Const wdFormatFilteredHTML                = 10
	Const wdFormatFlatXML                     = 19
	Const wdFormatFlatXMLMacroEnabled         = 20
	Const wdFormatFlatXMLTemplate             = 21
	Const wdFormatFlatXMLTemplateMacroEnabled = 22
	Const wdFormatHTML                        =  8
	Const wdFormatPDF                         = 17
	Const wdFormatRTF                         =  6
	Const wdFormatTemplate                    =  1
	Const wdFormatTemplate97                  =  1
	Const wdFormatText                        =  2
	Const wdFormatTextLineBreaks              =  3
	Const wdFormatUnicodeText                 =  7
	Const wdFormatWebArchive                  =  9
	Const wdFormatXML                         = 11
	Const wdFormatXMLDocument                 = 12
	Const wdFormatXMLDocumentMacroEnabled     = 13
	Const wdFormatXMLTemplate                 = 14
	Const wdFormatXMLTemplateMacroEnabled     = 15
	Const wdFormatXPS                         = 18

	' Create a File System object
	Set objFSO = CreateObject( "Scripting.FileSystemObject" )

	' Create a Word object
	Set objWord = CreateObject( "Word.Application" )

	With objWord
		' True: make Word visible; False: invisible
		.Visible = True
 
		' Check if the Word document exists
		If not( objFSO.FileExists( inFile ) ) Then
			WScript.Echo "FILE OPEN ERROR: The file does not exist" & vbCrLf
			' Close Word
			.Quit
			Exit Sub
		End If
 
		' Open the Word document
		.Documents.Open inFile
 
		' Make the opened file the active document
		Set objDoc = .ActiveDocument
 
		If StrComp(Ucase( outFormat ),"PDF") = 0 then
			wdFormat = wdFormatPDF 
		ElseIf StrComp(Ucase( outFormat ),"XPS") = 0 then
			wdFormat = wdFormatXPS
		ElseIf StrComp(Ucase( outFormat ),"TXT") = 0 then
			wdFormat= wdFormatTEXT
		ElseIf StrComp(Ucase( outFormat ),"HTML") = 0 then
			wdFormat= wdFormatHTML
		ElseIf StrComp(Ucase( outFormat ),"XML") = 0 then
			wdFormat= wdFormatXML
		ElseIf StrComp(Ucase( outFormat ),"RTF") = 0 then
			wdFormat= wdFormatXML
		Else
			WScript.Echo "FILE FORTMART ERROR: Unknown file format" & vbCrLf
			' Close Word
			.Quit
			Exit Sub
		End If

		' Save in PDF/XPS format
		objDoc.SaveAs outFile, wdFormat
 
		' Close the active document
		objDoc.Close
 
		' Close Word
		.Quit
	End With
End Sub

VBS枚举硬盘信息

1、GetHDInfo.vbs
这个脚本,是Google后找到的,虽然是VBS,但比网上绝大多数的代码,靠谱的多得多

'---------------------------------------------------
'Get the properties of all partitions on all drives, 
'including USB drives.
'Core code from the Scripting Guy
'7.1.2012 FNL
'---------------------------------------------------
Set oWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set cDiskDrives = oWMIService.ExecQuery("SELECT * FROM Win32_DiskDrive")

For Each oDrive In cDiskDrives
	WScript.echo "Disk #" & oDrive.Index & "(" & oDrive.InterfaceType & "): " _
		& oDrive.Caption & ", Size=" & Format(oDrive.Size, False) & " MBytes"
	WScript.echo "Part.  Drive          F/S   Size(MBytes)  Free(MBytes)  Active  Primary"
	WScript.echo String(71, "-")

	'WScript.Echo "ASSOCIATORS OF {Win32_DiskDrive.DeviceID=""" & Replace(oDrive.DeviceID, "\", "\\") & """} WHERE AssocClass = " & "Win32_DiskDriveToDiskPartition"

	Set cPartitions = oWMIService.ExecQuery("ASSOCIATORS OF {Win32_DiskDrive.DeviceID=""" _
		& Replace(oDrive.DeviceID, "\", "\\") & """} WHERE AssocClass = " & "Win32_DiskDriveToDiskPartition")
 
	For Each oPartition In cPartitions
		aPartition = Split(oPartition.DeviceID)
		Set cLogicalDisks = oWMIService.ExecQuery _
	 		("ASSOCIATORS OF {Win32_DiskPartition.DeviceID=""" & oPartition.DeviceID _
			& """} WHERE AssocClass = Win32_LogicalDiskToPartition")
 		if oPartition.Bootable         then sActive  = "Yes" Else sActive  = "No "
 		if oPartition.PrimaryPartition then sPrimary = "Yes" Else sPrimary = "No "
		For Each oLogicalDisk In cLogicalDisks
			For Each oVolume In cLogicalDisks
				sLabel = Left(oVolume.VolumeName & Space(12), 12)
			Next
			With oLogicalDisk
				sSpacer = Space(8 - Len(.FileSystem))
	 	   		WScript.Echo " " & aPartition(3) & "    " & .DeviceID & " " & sLabel _
				& .FileSystem & sSpacer & Format(.Size, True) & "       " _
				& Format(.FreeSpace, True) & "     " & sActive & "     " & sPrimary
			End With
		Next
	Next
	WScript.Echo
Next

Function Format(n, bPad)
	n = FormatNumber(n/1000000, 0, -1, 0, -1)
	if bPad then Format = Space(7-Len(n)) & n Else Format = n
End Function

2、运行

@REM do not use wscript GetHDInfo.vbs
@cscript GetHDInfo.vbs

Microsoft (R) Windows Script Host Version 5.8
Copyright (C) Microsoft Corporation. All rights reserved.

Disk #1(IDE): Hitachi HTS545032B9A302 ATA Device, Size=320,070 MBytes
Part.  Drive          F/S   Size(MBytes)  Free(MBytes)  Active  Primary
-----------------------------------------------------------------------
 #1    D: WinAPP      NTFS    319,862       182,455     No      Yes

Disk #0(IDE): Samsung SSD 850 EVO 500GB ATA Device, Size=500,105 MBytes
Part.  Drive          F/S   Size(MBytes)  Free(MBytes)  Active  Primary
-----------------------------------------------------------------------
 #1    E: MacSSD      HFS     256,114        89,747     No      Yes
 #3    C: BOOTCAMP    NTFS    242,999        45,934     Yes     Yes

Press any key to continue . . .