Jump to content

Welcome to MSFN Forum
Register now to gain access to all of our features. Once registered and logged in, you will be able to create topics, post replies to existing threads, give reputation to your fellow members, get your own private messenger, post status updates, manage your profile and so much more. This message will be removed once you have signed in.
Login to Account Create an Account


Photo

Code Repository

- - - - -

  • Please log in to reply
22 replies to this topic

#1
Gouki

Gouki

    MSFN Expert

  • Member
  • PipPipPipPipPipPip
  • 1,168 posts
The main objective of this thread is to give users a 'central' thread containing all the code they may need.

You can post your code here, however, there are simple rules you must follow.
This will keep this thread clean and organized, making life easier to everyone.

These fields are required unless otherwise noted. All submissions without them will be deleted.
  • Description: Give us a small description of what the code/application does.
  • Screenshot - Optional - In case you're posting an application and not a script (where you can easily paste the code into a code box), feel free to post a screenshot if you think it would be useful.
  • Programming Language: All programming languages are accepted. Simply specify which one you app or script uses.
That's it. Now ATTACH (not post) your code.

Please, only one submission per post.

Don't make posts asking for help or commenting on an application/code you saw here. Instead, PM the author with the request.

Posts that are not considered to be submissions will be deleted.

Thank you for participating.

P.S: Taking someone else's work and pretending it is your own is not something you should do. Always credit your sources. Any code here found to be plagiarized without source credits will be deleted.


How to remove advertisement from MSFN

#2
Yzöwl

Yzöwl

    Wise Owl

  • Super Moderator
  • 4,530 posts
  • OS:Windows 7 x64
  • Country: Country Flag

Donator

Have you ever wanted to pause a NT Command Script, without using the ping command, vbs or a third party utility?

Here's my way of doing it! (see the bottom of this post for the attached file)

This is an NT Command Script, (batch file), just place addelay.cmd somewhere in your path and call it from another script, like this:CALL ADDELAY [mins] [secs]
Where

[mins] is an integer representing the number of minutes you wish to delay for.
and
[secs] is an integer representing the number of seconds you wish to delay for.


If you don't wish to have any minutes, your first parameter, [mins], should be 0

Examples:CALL ADDELAY 0 15

delays the running NT Command Script by 15 seconds


CALL ADDELAY 1 7

delays the running NT Command Script by 1 minute and 7 seconds


CALL ADDELAY 3

delays the running NT Command Script by 3 minutes


CALL ADDELAY 0 72

delays the running NT Command Script by 72 seconds


Additionally:CALL ADDELAY

displays an error message and delays the running NT Command Script for five seconds


CALL ADDELAY 0

displays an error message and delays the running NT Command Script for five seconds


CALL ADDELAY 0 0

displays an error message and delays the running NT Command Script for five seconds



This is not intended to be a precision timepiece, so please don't start complaining about it being slightly inaccurate. I know it is, but it does the job for which I intended it. I hope it is useful!

Attached Files


Edited by Yzöwl, 08 May 2006 - 01:17 AM.


#3
phkninja

phkninja

    Advanced Member

  • Member
  • PipPipPip
  • 466 posts
Program: Blowfish File Encyptor (command line)
Description:
This is a small application i wrote that implements the Blowfish Encryption algorythm. The archive contains a header for Blowfish Encryption/Decryption, a Header file to implement MD5 hash algorythm (required by command line program), and a command line program source file.

The command line program is a fully functional file encryptor. If the supplied password is less than 128 bits [16 characters long] it uses an MD5 hash of the password as a key, as it is recommended that password be at least 128 bits to be secure, and can take password up to 56 characters long which is the limit of the Blowfish algorythm.

Language: C, but will work in C++

(Removed from my website)

Attached File  blowfish.7z   19.05KB   95 downloads
or
Attached File  blowfish.exe   102.05KB   91 downloads

Edited by phkninja, 02 February 2007 - 10:37 AM.


#4
Maelstorm

Maelstorm

    AT Field Pattern Blue

  • Member
  • PipPip
  • 265 posts
Description: Function to change computer name.
Language: AutoIT3 3.1.1.x beta

Usage:
Call function with name you want to changed the computer to.
Returns 0 on success, 1 on error.
Reboot computer for changes to take effect.


Attached File  SetSystemName.txt   703bytes   199 downloads



Description: Function to Join a Workgroup (Windows XP Only)
Language: AutoIT3 3.1.1.x beta

Usage:
Call function with name of desired workgroup that you want to join.
Returns 0 on success, 1 on failure.
Reboot computer for changes to take effect.


Attached File  SetNetworkWorkgroup.txt   671bytes   152 downloads

Description: Function to join a Domain (Windows XP Only)
Language: AutoIT3 3.1.1.x beta

Usage:
Call function with name of domain to join, a userid, and password.
The UserID and Password should be an admin account on the domain controller.
Reboot computer for changes to take effect.

Attached File  SetNetworkDomain.txt   988bytes   128 downloads



Note to Moderator:

I posted these as separate posts, but for some reason the board keeps merging them into one large post.

Edited by Maelstorm, 22 May 2006 - 09:21 PM.

MAELSTORM

#5
Djé

Djé

    accent artist

  • Member
  • PipPipPip
  • 359 posts
  • Description: Substring search function that can search starting from the left or from the right.
  • Programming Language: Visual Basic (for Applications, but I guess it works also with VB & VBS).
VB functions for searching a substring in another string (like Instr()) all start from the left and search in the right direction, with an optional start parameter to start searching only from this position.
No easy way to find the last occurance of the substring (like when you want to discriminate a file name from a file path searching for "\").

The attached function can accept a negative 'start' argument to start the search left wise from the end of the string, with a 'start' offset (also from the end).
Both the offset and the returned position still apply to the leftmost character of the substring.

Example usage code provided in the attachement.

The 'maths' involved to avoid an unlegant 'If start<0...' were interesting...
There is also another way arround using StrReverse(), but it is in fact not much simpler.

Attached Files


Those who do not learn from History are doomed to repeatedly fail their History exams.

#6
RogueSpear

RogueSpear

    OS: SimplyMEPIS

  • MSFN Sponsor
  • 1,529 posts
Description: Generate MD5 Values of Files
Language: Visual Basic 2005 [Function]
Usage: String = GenerateFileHash(filename)

My initial search for examples on this led me to an example of using MD5 with strings. Specifically, using MD5 to secure the transmisson of passwords. You can find that article here. I spent quite some time trying to rework the example code to work with files rather than strings. Further searching yielded only a single example, in C#, at the MSDN forums. While not very helpful for VB, it did open my eyes to the BitConverter function.

Private Function GenerateFileHash(ByVal SourceFile As String) As String
		Dim strFile As New IO.FileStream(SourceFile, IO.FileMode.Open, IO.FileAccess.Read)
		Dim MD5 As New MD5CryptoServiceProvider()
		Return BitConverter.ToString(MD5.ComputeHash(strFile)).Replace("-", "")
		strFile.Close()
	End Function

Attached Files



#7
sebbe1991

sebbe1991

    Newbie

  • Member
  • 31 posts
Description: Sets the computername
Language: C++

Screenshot
Attached File  SetComputerNameGUI.7z   44.68KB   170 downloads

#8
Djé

Djé

    accent artist

  • Member
  • PipPipPip
  • 359 posts
Description: VB Array Functions.
Programming Language: Visual Basic (for Applications, but I guess it works also with VB & VBS).
Usage: Have the whole set in a module of your project, or just insert in your code the function(s) that you need (beware of dependancies).

VB's handling of arrays is under everything. Especially when compared to other languages.
Those functions will come handy to everyone seeking to make something out VB arrays.

Yes, they are the same as those I'm using in my Excel ProgsLists generator.

'-Double-check but most of them should work with any array, even not 0-base-indexed (no relevant for VBS).
'-Arrays are normally passed ByRef, so the args are updated by the function.
'-They are fairly tested, but the usual disclaimer apply.

Not all array handling functionnalities of other languages are implemented here. If you have other functions that you'd like to be included in the set, PM me.

Content:
'* Returns true if the array has at least the specified number of elements (default to one element)
Function isSetArray(anArray, Optional minSize As Integer = 1) As Boolean

Dim myArray(), anything
isSetArray(myArray) -->False
isSetArray(anything) -->False
myArray=Array("test")
isSetArray(myArray) -->True
myArray=Array()
isSetArray(myArray) -->False
myArray=Array("a", "b", "c")
isSetArray(myArray, 3) -->true
isSetArray(myArray, 4) -->False

* Drops the first element out of the array and returns it
- in the array, the other elements' index is decreased by one
Function arrayDrop(anArray())
* Pops the last element out of the array and returns it
- the array passed as an argument loose this element
Function arrayPop(anArray())
* adds 'avalue' as a new element at the end of the array
Function arrayAdd(anArray(), aValue)
* Merges the 2 arrays in the 1st one and returns it
Function arrayMerge(Array1(), ByVal Array2)
* Like the 'Join' function but with more possibilities
Function implode(anArray(), Optional separator As String = " ", Optional keepEmptyElem As Boolean = False)
* Like the 'Split' function but actually working with line breaks!
- Try: Split(myString, vbcrlf) -> error
Function explode(theString As String, Optional separator As String = " ", Optional keepEmptyElem As Boolean = False)
* Translates an array containing arrays [like array(i)(j)] to a bidimentional array [like array(i, j)]
- The second dimension depends on the dimension of array(0)
- The array passed as an argument is NOT updated
Function arrayRect(anArray())
* Similar to Splice in JS: remove/insert some elements in the array
- starts operating at the 'start' position (from 1st element=0)
- removes 'count' elements
- inserts the elements of 'additions', which has to be an array (if passed)
Function arraySplice(anArray(), start As Integer, Optional count As Integer = 1, Optional additions As Variant)


Restriction: Except for 'isSetArray()' and the second arrays of arrayMerge & arraySplice, the array arguments are passed ByRef so they must be declared as arrays prior to pass them to the functions:

Dim myArray()
arrayAdd myArray, newValue

To change this and be able to pass anything (!), you may remove the '()' in the declaration:

Function arrayAdd(anArray(), aValue)


[Edits]:
- v0.0.2. Improvements to isSetArray, arrayMerge, implode & arraySplice. Addition of explode.
- Testing Sub() procedure at the bottom of the module.

Attached Files


Edited by Djé, 20 June 2006 - 09:59 AM.

Those who do not learn from History are doomed to repeatedly fail their History exams.

#9
Guest_Nazi Moderation_*

Guest_Nazi Moderation_*
  • Guests
Purpose: to wait a specified number of seconds
Language: batch script, so just stick this code inside a text file and name it .bat or .cmd

@echo off
set start=
set secstowait=%1
if defined secstowait (goto :wait)
echo ìììììììììììììììììììììììììììììììììììììììììììììììììììììììììììììì
echo   USAGE: %0 X where X is number of seconds to wait.
echo   EXAMPLE: %0 30
echo					(C) 2006 MSFN.ORG
echo ìììììììììììììììììììììììììììììììììììììììììììììììììììììììììììììì
goto :eof
:wait
FOR /F "tokens=1-3 delims=:." %%i in ("%time%") do set hour=%%i&set minute=%%j&set seconds=%%k
if not defined start set /a start=(%hour%*3600)+(%minute%*60)+%seconds%
set /a current=(%hour%*3600)+(%minute%*60)+%seconds%
set /a elapsed=%current%-%start%
if %elapsed% LSS 0 (goto :eof)
if %elapsed% GEQ %secstowait% (echo Finished! Waited %elapsed% seconds.) else goto :wait

i got the idea for this off of the MSFN forums, but then i couldn't find the original program, so i created this. it is 100% my code and completely free to distribute.

just updated the script so that it will exit if midnight strikes while the script is running. if you wish you could edit it to return an errorcode when that happens.

Attached Files

  • Attached File  wait.cmd   735bytes   92 downloads

Edited by Nazi Moderation, 02 July 2006 - 04:10 AM.


#10
#rootworm

#rootworm

    Member

  • Member
  • PipPip
  • 206 posts
full-featured command line driven vbs script for creating shortcuts.
i've seen many many examples that only show a couple shortcut parameters, i think this one has them all.

set objWSHShell = CreateObject("WScript.Shell")

if WScript.Arguments.Named.Exists("file") then
Path=WScript.Arguments.Named.Item("file") & ".lnk"
set objSC = objWSHShell.CreateShortcut(Path) 
else
call Usage
end if

if WScript.Arguments.Named.Exists("desc") then
objSC.Description=WScript.Arguments.Named.Item("desc")
end if

if WScript.Arguments.Named.Exists("target") then
objSC.TargetPath=WScript.Arguments.Named.Item("target")
else
call Usage
end if

if WScript.Arguments.Named.Exists("arg") then
objSC.Arguments=WScript.Arguments.Named.Item("arg")
end if

if WScript.Arguments.Named.Exists("icon") and WScript.Arguments.Named.Exists("index") then
objSC.IconLocation = WScript.Arguments.Named.Item("icon") & "," & WScript.Arguments.Named.Item("index")
elseif WScript.Arguments.Named.Exists("icon") then
objSC.IconLocation = WScript.Arguments.Named.Item("icon") & ",0"
end if

if WScript.Arguments.Named.Exists("wstyle") then
objSC.WindowStyle = WScript.Arguments.Named.Item("wstyle")
end if

if WScript.Arguments.Named.Exists("hotkey") then
objSC.HotKey = WScript.Arguments.Named.Item("hotkey")
end if

if WScript.Arguments.Named.Exists("dir") then
objSC.WorkingDirectory = WScript.Arguments.Named.Item("dir")
end if

objSC.Save

sub Usage()
UsageText="Usage: shortcut.vbs /file: /target: /desc: /arg: /dir: /icon: /index: /wstyle: /hotkey:"_
&VbCrLf&VbCrLf&"(required) file is the filename for the shortcut, minus .lnk, i.e. /file:""C:\My Shortcut"""_
&VbCrLf&"(required) target is the file to create a shortcut to, i.e. /target:""c:\windows\notepad.exe"""_
&VbCrLf&"(optional) desc is the info tip for the shortcut, i.e. /desc:""This is my shortcut"""_
&VbCrLf&"(optional) arg sets the command-line argument for the target, i.e. /arg:c:\autoexec.bat"_
&VbCrLf&"(optional) dir sets the working directory for the shortcut, i.e. /dir:c:\"_
&VbCrLf&"(optional) icon is the file containing the icon for the shortcut, i.e. /icon:shell32.dll"_
&VbCrLf&"(optional) index of the icon to use from icon file, (defaults to 0) i.e. /index:40"_
&VbCrLf&"(optional) wstyle sets the window style for the shortcut, i.e. /wstyle:3"_
&VbCrLf&"1 = normal, 3 = maximize window, 7 = minimize window"_
&VbCrLf&"(optional) hotkey is the hotkey combination to assign, i.e. /hotkey:""ctrl+alt+shift+x"""
Wscript.Echo(UsageText)
Wscript.Quit
end sub

Edited by #rootworm, 24 October 2006 - 04:56 AM.

bpx messageboxa

#11
cluberti

cluberti

    Gustatus similis pullus

  • Supervisor
  • 11,250 posts
  • OS:Windows 8.1 x64
  • Country: Country Flag
Description: VBscript subroutine to run elevated on Vista/Server 2008 when UAC is enabled.
Programming Language: VBScript
Usage: When a VBScript needs to run on Vista/Server 2008 and access parts of the system UAC protects when UAC is enabled, the script will simply fail. However, after calling this subfunction from your script, UAC will prompt when the script is run, and the script will continue once UAC elevation is allowed. Note that this also works on 2K3/XP when the user running the script is a non-Administrative user (a runas dialog will appear instead of a UAC prompt, obviously, but otherwise the same principles apply).

Attached Files


MCTS Windows Internals, MCITP Server 2008 EA, MCTS MDT/BDD, MCSE/MCSA Server 2003, Server 2012, Windows 8
--------------------
Please read the rules before posting!
Please consider donating to MSFN to keep it up and running!

#12
gunsmokingman

gunsmokingman

    MSFN Master

  • Super Moderator
  • 2,418 posts
  • OS:none specified
  • Country: Country Flag
Description:
Hta that produces a Vbs Script called DeleteIt.vbs. This is places in the user SendTo Folder.
Uses Wscript.arguments to pass the path of the files or folder to be deleted.
This is a perminent delete and does not use the Recyle Bin or System Volume Information.
Hta also has a Remove Button to remove the DeleteIt.vbs from the user SendTo Folder.

Programming Language:
HTML, JS script, Vbs Script

Usage:
I wrote the original script because I wanted a fast way to delete things.

Note:
There is a limit to how many file or folders can be deleted, 24 items is it limits at one time.
This is a SFX file so it acts like a exe

Edit
Since I made this on Vista it works fine, on XP it did not work properly, that been fixed.

Attached Files


Edited by gunsmokingman, 06 March 2008 - 01:19 PM.



GunSmokingMan



#13
mschol

mschol

    Newbie

  • Member
  • 10 posts
because the basic GetFiles() method of VB.net wasn't good enough for me i build my own function in order to do what i needed

Description:
the Getfiles() method of VB.net can only handle one fileextension and crashes when it tries to read from system volume information or a Reparsepoint
i thought of my own solution to that problem: build a function that searches a given directory for files that match a give Regular expression, and skip folders which you enter

Usage
searchFileSystem(path As String,searchPattern As String,searchOption As IO.SearchOption) As ArrayList
path = a path (i.e. c:\)
searchstring = a regular expression (i.e. .*?\.(avi|ogm|mkv|mpg|mp3|rar|mp4|mpeg|txt)$ for matching files with one of the extensions)
SearchOption = wheter to search only the topmost directory or also search in the subdirectory's

inside the function it also has a reference to an array which contains the folders where NOT to search
If excluded.BinarySearch(d.Name) < 0 Then
excluded is in my function a Arraylist
Language
VB.net


i included a file thats not directly usable, you have to implement it in your own code.
i did include a few lines of code to show how u could use it


it might not be the best code availble but since i couldnt find any function that did it this way i build it myself. (one of my very first VB.net things :) )

Attached Files



#14
cluberti

cluberti

    Gustatus similis pullus

  • Supervisor
  • 11,250 posts
  • OS:Windows 8.1 x64
  • Country: Country Flag
Description: VBscript to gather some basic computer information, including locale, install date, current time, etc.
Programming Language: VBScript
Usage: Use cscript to launch, otherwise you'll get lots of pop-ups from wscript.

Output:
------------------------------------------
				   System Details
	 ------------------------------------------

	 Computer Name:		COMPUTER


	 Operating System Information:
	 =============================
	 Operating System:	 Microsoft Windows 7 Ultimate 64-bit
	 Version:			   6.1.7600 Ultimate Edition
	 Build Type:			Multiprocessor Free
	 Locale:				English (United States)
	 Serial Number:		 XXXXX-XXX-XXXXXXX-XXXXX

	 Current Time Zone:	 Eastern Standard Time
	 Offset from UTC:	   -5 hours
	 DST In Effect:		 False

	 Windows PID Key:	   XXXXX-XXXXX-XXXXX-XXXXX-XXXXX
	 Office 2010 PID Key:   XXXXX-XXXXX-XXXXX-XXXXX-XXXXX

	 Install Date:		  7/23/2009 4:24:52 PM
	 Last Boot Time:		12/21/2009 4:25:21 PM
	 Local Date/Time:	   12/28/2009 6:54:42 PM

	 System Status:		 OK


	 Hardware Information:
	 =====================
	 CPU:				  Intel(R) Core(TM)2 Quad CPU	Q6600  @ 2.40GHz (x64)

	 Physical Memory:	  7.92 GB

	 Video Card:		   Radeon X1550 Series (Microsoft Corporation - WDDM)
	 Adapter DAC:		   Internal DAC(400MHz)
	 PNP Device ID:		 PCI\VEN_1002&DEV_7143&SUBSYS_204E17AF&REV_00\4&2FFCA7E0&0&00E1
	 Video RAM:			 256 MB
	 Driver Version:		8.56.1.15
	 Driver Date:		   4/24/2009

	 Video Card:		   Radeon X1550 Series Secondary (Microsoft Corporation - WDDM)
	 PNP Device ID:		 PCI\VEN_1002&DEV_7163&SUBSYS_204F17AF&REV_00\4&2FFCA7E0&0&01E1
	 Driver Version:		8.56.1.15
	 Driver Date:		   4/24/2009

	 Video Card:		   ATI Radeon HD 2600 Pro (Microsoft Corporation WDDM 1.1)
	 Adapter DAC:		   Internal DAC(400MHz)
	 PNP Device ID:		 PCI\VEN_1002&DEV_9589&SUBSYS_E410174B&REV_00\4&324FA3B&0&0008
	 Video RAM:			 256 MB
	 Driver Version:		8.56.1.15
	 Driver Date:		   4/24/2009

	 Sound Card:		   High Definition Audio Device
	 Manufacturer:		  Microsoft
	 PNP Device ID:		 HDAUDIO\FUNC_01&VEN_11D4&DEV_1884&SUBSYS_103C2819&REV_1001\4&2260D901&0&0001

	 Sound Card:		   USB Audio Device
	 Manufacturer:		  (Generic USB Audio)
	 PNP Device ID:		 USB\VID_045E&PID_070F&MI_00\6&216596F4&0&0000

	 Sound Card:		   High Definition Audio Device
	 Manufacturer:		  Microsoft
	 PNP Device ID:		 HDAUDIO\FUNC_01&VEN_1002&DEV_AA01&SUBSYS_00AA0100&REV_1000\5&36D18A18&0&0001

	 Volume:			   C:
	 Compressed:			False
	 File System:		   NTFS
	 Volume Size:		   465.67 GB
	 Free Space:			368.08 GB

	 Network Adapter:	  Intel(R) 82566DM-2 Gigabit Network Connection
	 MAC Address:		   00:0F:FE:83:0B:63
	 DHCP Enabled:		  True
	 IP Address:			192.168.200.100
	 Subnet Mask:		   255.255.255.0
	 Default Gateway:	   192.168.200.1
	 Lease Obtained:		12/28/2009 4:13:18 PM
	 Lease Exipres:		 12/29/2009 4:13:18 PM
	 DHCP Servers:		  192.168.200.10
	 DNS Server:			192.168.200.15,192.168.200.16,
	 WINS Primary Server:   192.168.200.16
	 WINS Secondary Server: 192.168.200.15
	 Enable LMHosts Lookup: True


	 System Information:
	 ===================
	 Computer:			 HP Compaq dc7800 Convertible Minitower
	 Serial Number:		 2UA81017DR
	 BIOS Version:		  786F1 v01.04
	 UUID:				  XXXXXXXX-XXXX-XXXX-XXXX-XXXXXXXXXXXX

Attached Files


MCTS Windows Internals, MCITP Server 2008 EA, MCTS MDT/BDD, MCSE/MCSA Server 2003, Server 2012, Windows 8
--------------------
Please read the rules before posting!
Please consider donating to MSFN to keep it up and running!

#15
gunsmokingman

gunsmokingman

    MSFN Master

  • Super Moderator
  • 2,418 posts
  • OS:none specified
  • Country: Country Flag
Here are four examples of a HTA that self closes and displays a bar graph of the count down
Posted Image

Code Only For Count Down Fixed Sized Bar Graph

<TITLE>Demo Close Graph</TITLE>
<HTA:APPLICATION 
     Id="GsmCloseCntDownFixSized" 
     APPLICATIONNAME="GsmGraphDemo3"
     SCROLL="no"
     SINGLEINSTANCE="yes"
     WINDOWSTATE="minimize"
     SELECTION="NO"
     CONTEXTMENU = "NO"
     BORDER="Thin"
     BORDERStyle = "Normal"
     INNERBORDER = "YES"
     NOWRAP
     MAXIMIZEBUTTON = "NO"
     MINIMIZEBUTTON = "NO"
     SYSMENU = "NO">
 <STYLE Type='text/css'>
   Body
    {
     Font-Size:9.75pt;
     Font-Weight:Bold;
     Font-Family:Arial,Tahoma,Comic Sans MS,Segoe Ui;
     Color:#203063;
     BackGround-Color:Transparent;
     Filter:progid:DXImageTransform.Microsoft.Gradient
     (StartColorStr='#ece6e0',endColorStr='#c0bab4');
     Margin-Top:5;
     Margin-Bottom:5;
     Margin-Left:2;
     Margin-Right:2;
     Padding-Top:5;
     Padding-Bottom:5;
     Padding-Left:2;
     Padding-Right:2;
     Text-Align:Center;
     Vertical-Align:Top;
     Border-Top:2px Solid #dbd5d1;
     Border-Bottom:4px Solid #c6c1ba;
     Border-Left:2px Solid #c1bdb9;
     Border-Right:3px Solid #d7d1cb;
    }
   .pgbar 
    {
     filter:progid:DXImageTransform.Microsoft.Gradient
     (GradientType=0,StartColorStr='#44DC88',endColorStr='#005a00')
    }
</STYLE>
  <script LANGUAGE='VBScript'>
  Dim Tx1 :Tx1 = " Seconds Remaining"
'-> Controls The Loop Count
  Dim C1 :C1 = 100  
  Function Window_OnLoad()
   self.Focus
   self.resizeTo 350,125
   self.MoveTo screen.availWidth / 2 - 350/2,screen.availHeight / 2 -125/2
   bar.style.width = "100%"
   TextDsp("10")
   DemoSelf()
  End Function
  Function DemoSelf()
   If C1 = 0 Then
     window.close()
    Else
    Select Case C1
     Case 90 :TextDsp("09")
     Case 80 :TextDsp("08")
     Case 70 :TextDsp("07")
     Case 60 :TextDsp("06")
     Case 50 :TextDsp("05")
     Case 40 :TextDsp("04")
     Case 30 :TextDsp("03")
     Case 20 :TextDsp("02")
     Case 10 :TextDsp("01")
    End Select 
     If Not bar.style.width < "100%" Or bar.style.width > "0%" Then
      BarSize(C1)
      Else
      BarSize(C1)
     End If
     C1 = C1 - 1
    End If 
   idTimer = window.setTimeout("DemoSelf", 100, "VBScript")   
  End Function
'-> Resize The Bar
  Function BarSize(N)
   If N > 1 Then
     document.title = FormatPercent(N / 100 ,2)
   End If 
   bar.style.width = n * 2.50 
  End Function
  Function TextDsp(NM)
   Txt.innerHTML= NM & Tx1
  End Function
  </SCRIPT>
 <BODY Scroll='No'>
  <TABLE>Demo Self Close</TABLE>
  <TABLE Style='Margin:3pt;'>
   <TD><DIV ID='Txt1' Style='Font-Size:9.25pt;Font-Family:Lucida Console;Font-Weight:Bold;Color:#000047;'>
   This Will Close When Timer Reaches Zero</DIV></TD>
 </TABLE>  
<!-- 
 To Make The Bar Thick Or Thinner Change Font Size 
 The Graph Size Is Fixed And Will Alway Be Based
 Upon This Is Width:200pt
-->
 <DIV Align='Left' Style="Width:200pt;Border-width:1;Border-style:solid;Border-color:#BBBBBB;Font-size:9.25pt">
<!-- Position The Text In The Bar Graph Area -->
  <SPAN ID="bar" Class=pgbar></SPAN>
  <SPAN ID="Txt" Style='Position:Absolute;Top:57;Left:88;Font-Family:Lucida Console;Font-Weight:Bold;Color:#003434;'></SPAN>
 </DIV>
</BODY>


There will be a error in the text display of Demo_CountUpVaribleSizeGraph.hta
Change This

'-> Text Display In Bar Graph Area
  Function TextDsp(NM)
     Txt.innerHTML= NM
  End Function


To This

'-> Text Display In Bar Graph Area
  Function TextDsp(NM)
     Txt.innerHTML= NM & Tx1
  End Function

Attached Files




GunSmokingMan



#16
dencorso

dencorso

    Adiuvat plus qui nihil obstat

  • Super Moderator
  • 5,782 posts
  • OS:98SE
  • Country: Country Flag

Donator

Description: VBscript to remove duplicate lines from plain text files.
Programming Language: VBScript
Usage: YankLines <input_filename> <output_filename>

Well, I claim no originality here at all, all I did was performing some pretty basic good housekeeping, and joining pieces of great code written by others...

I needed a program to remove duplicate lines from lists which I update by appending, such as the HOSTS file and some log files. These are too long to clean up by hand. I searched and found an awesome VBScript program, by Max Damage (at MS Technet's Script Center), that does it fast and reliably (reference: Remove Duplicate Lines From a Text File)... however it's not quite user friendly, because one has to modify the code each time it's used, because the filename is hardcoded in the script. So I added some quite standard code for it to recieve the source and output filenames from the command-line, to resolve this problem, and incorporated cluberti's clever subroutine RunMeWithCScript() to avoid getting lots of pop-ups from wscript. And that was it. But it works so well that I thought I should share it with all other users needing such a program, because I really didn't find anything like it free and readily available on the net. [Later edit: Thanks to tomasz86, the code has been improved: it turns out that the first posted version was case-sensitive, which, IMO, is undesirable. So, I've updated the script to correct this (just one more line added, including a comment on how to reverse it, when necessary). One page from the MS 2k Scripting Guide (Configuring Dictionary Properties), where the subject is further discussed is the relevant reference for this. Thanks also to jaclaz, for suggesting the alternative yanklinescs.vbs (case sensitive version), now added to the attached .7z. For the source of these improvements, see this thread.]

Together with yanklines.vbs, in the attached 7z file, there is also believe.txt, a nice test file I copied from How Can I Remove All Duplicate Lines From a Text File? (by the Scripting Guy), which also presents another interesting way of solving the problem of the duplicate lines (which I didn't actually test because I'd already solved my problem using yanklines.vbs).

Attached Files



#17
cluberti

cluberti

    Gustatus similis pullus

  • Supervisor
  • 11,250 posts
  • OS:Windows 8.1 x64
  • Country: Country Flag
Description: VBscript to modify or delete the paging file from a Windows system via WMI or direct registry edit.
Programming Language: VBScript
Usage: Remove the .txt extension from the attached file, and either run from cscript or double-click the .vbs.

'// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'//
'// NAME:        setpagefile.vbs
'//
'// Original:    http://www.cluberti.com/blog
'// Last Update: 16th June 2010
'//
'// Comment:     VBS example file for use in configuring the paging file on Windows
'//
'// NOTE:        Provided as-is - usage of this source assumes that you are at the
'//              very least familiar with the vbscript language being used and
'//              the tools used to create and debug this file.
'//
'//              In other words, if you break it, you get to keep the pieces.
'//
'// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Option Explicit
Dim strComputer, strPageFileSizeInput, strPageFileNameInput, strInput
Dim objWMIService, objStaticPageFileItem, objDynamicPageFileItem, objShellApp
Dim colStaticPageFileItems, colDynamicPageFileItems, isRunning, execOutput, gErrData, bRebootNeeded, bNoStaticPageFile, bNoPageFile

'// Ensure that cscript is the engine used to run this script:
RunMeWithCScript()

On Error Resume Next

'// Configure our variables:
strComputer = "."
bRebootNeeded = False
bNoStaticPageFile = True
bNoPageFile = True

Set objShellApp = CreateObject("WScript.Shell")
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
'// Win32_PageFile is deprecated - it still (mostly) works, but Win32_PageFileSetting is not deprecated, so use that:
Set colStaticPageFileItems = objWMIService.ExecQuery("SELECT * FROM Win32_PageFileSetting",,48)
Set colDynamicPageFileItems = objWMIService.ExecQuery("SELECT * FROM Win32_PageFileUsage",,48)

'// Execute the ChangePagingFile sub:
ChangePagingFile()

'// Check execution of ChangePagingFile(), and handle when "system managed" is set, or no paging file exists:
If bRebootNeeded = True Then
    RebootSystem()
Else
    '// Can't use WMI to create a paging file when it is "system managed" or none exists - handle this condition:
    If bNoStaticPageFile = True Then
        CheckForDynamicPagingFile()
        If bNoPageFile = False Then
            WScript.Quit
        Else
            If bNoPageFile = True Then
                WScript.Echo "No paging file found."
                WScript.Echo ""
                strPageFileNameInput = UserInput("Enter new pagefile name (full path and filename) - leave blank to use C:\pagefile.sys: ")
                strPageFileSizeInput = UserInput("Enter new pagefile size (in MB) - leave blank to keep the system with no paging file:  ")
                
                '// Check to see if the user left the input blank, otherwise set up a paging file:
                If Not strPageFileSizeInput = "" Then
                    If strPageFileNameInput = "" Then
                        strPageFileNameInput = "C:\pagefile.sys"
                    End If
                    WScript.Echo "New pagefile file will be: " & strPageFileNameInput
                    WScript.Echo "New pagefile size will be: " & strPageFileSizeInput & "MB"
                    bNoStaticPageFile = False
                    
                    '// Change the registry to add paging file information:
                    objShellApp.Exec("reg add ""HKLM\System\CurrentControlSet\Control\Session Manager\Memory Management"" /v PagingFiles /t REG_MULTI_SZ /d """ & strPageFileNameInput & " " & strPageFileSizeInput & " " & strPageFileSizeInput & """ /f")
                    
                    '// Check the return to make sure we succeeded - otherwise, tell the user why we didn't:
                    If Not Err.Number = 0 Then
                        gErrData = gErrData & vbCrLf & "Error writing to registry - reason: " & Err.Number & "  - " & Err.Description
                        WScript.Echo gErrData
                        Err.Clear
                    Else
                        WScript.Echo "Registry edit to add " & strPageFileNameInput & " as size " & strPageFileSizeInput & "MB was successful."
                        bRebootNeeded = True
                    End If
                
                '// If we've made changes that have succeeded, we need to reboot - otherwise, do nothing:
                    If bRebootNeeded = True Then
                        RebootSystem()
                    Else
                        WScript.Echo "No changes made that require a reboot.  Exiting script."
                    End If
                Else
                    WScript.Echo "You have elected to continue with no paging file.  Exiting script."
                End If
            Else
                WScript.Echo "No changes made that require a reboot.  Exiting script."
            End If
        End If
    End If
End If


Sub ChangePagingFile()
    For Each objStaticPageFileItem In colStaticPageFileItems
        '// There's a static paging file - use WMI to make changes:
        bNoStaticPageFile = False
        bNoPageFile = False
        
        WScript.Echo " --------------------------"
        WScript.Echo "  Current PageFile Details"
        WScript.Echo " --------------------------"
        WScript.Echo "Name:                " & objStaticPageFileItem.Name
        WScript.Echo "InitialSize:         " & objStaticPageFileItem.InitialSize
        WScript.Echo "MaximumSize:         " & objStaticPageFileItem.MaximumSize
        WScript.Echo ""
        
        '// Get user input:
        strInput = UserInput("Enter new pagefile size (in MB) - leave blank to delete existing paging file: ")
        
        '// If the user entered a value, configure the new paging file size:
        If Not strInput = "" Then
        WScript.Echo "New pagefile size will be: " & strInput & "MB"
            WScript.Echo ""
            
            objStaticPageFileItem.InitialSize = strInput
            objStaticPageFileItem.MaximumSize = strInput
            objStaticPageFileItem.Put_
            bRebootNeeded = True
            
            WScript.Echo " --------------------------"
            WScript.Echo "    New PageFile Details"
            WScript.Echo " --------------------------"
            WScript.Echo "Name:                " & objStaticPageFileItem.Name
            WScript.Echo "InitialSize:         " & objStaticPageFileItem.InitialSize
            WScript.Echo "MaximumSize:         " & objStaticPageFileItem.MaximumSize
            WScript.Echo ""
            WScript.Echo "A reboot is needed for this change to take effect."
        
        '// If the user left the input blank, delete the paging file - note that Delete and DeleteEx from Win32_PagingFile are deprecated, and
        '// while they'll return 0 on Windows 7, they don't actually delete the paging file.  Using reg add instead, as it works just fine:
        Else
            WScript.Echo "Deleting paging file: " & objStaticPageFileItem.Name
            objShellApp.Exec("reg add ""HKLM\System\CurrentControlSet\Control\Session Manager\Memory Management"" /v PagingFiles /t REG_MULTI_SZ /d """" /f")
            
            '// Check the return to make sure we succeeded - otherwise, tell the user why we didn't:
            If Not Err.Number = 0 Then
                gErrData = gErrData & vbCrLf & "Error writing to registry - reason: " & Err.Number & "  - " & Err.Description
                WScript.Echo gErrData
                Err.Clear
            Else
                WScript.Echo "Registry edit to remove " & objStaticPageFileItem.Name & " was successful."
                bRebootNeeded = True
            End If
        End If
    Next
End Sub


Sub CheckForDynamicPagingFile()
    For Each objDynamicPageFileItem In colDynamicPageFileItems
        '// There's a paging file - use WMI to make changes:
        bNoPageFile = False
        
        WScript.Echo "Paging file is configured for 'System managed size'"
        WScript.Echo ""

        WScript.Echo " --------------------------"
        WScript.Echo "  Current PageFile Details"
        WScript.Echo " --------------------------"
        WScript.Echo "Name:                " & objDynamicPageFileItem.Name
        WScript.Echo "Size:                " & objDynamicPageFileItem.AllocatedBaseSize
        WScript.Echo "Current Usage:       " & objDynamicPageFileItem.CurrentUsage
        WScript.Echo ""
        
        WScript.Echo ""
        strPageFileNameInput = UserInput("Enter new pagefile name (full path and filename) - leave blank to use C:\pagefile.sys: ")
        strPageFileSizeInput = UserInput("Enter new pagefile size (in MB) - leave blank to remove the paging file:               ")
        
        '// Check to see if the user left the input blank, otherwise set up a paging file:
        If Not strPageFileSizeInput = "" Then
            If strPageFileNameInput = "" Then
                strPageFileNameInput = "C:\pagefile.sys"
            End If
            WScript.Echo "New pagefile file will be: " & strPageFileNameInput
            WScript.Echo "New pagefile size will be: " & strPageFileSizeInput & "MB"
            bNoStaticPageFile = False
            
            '// Change the registry to add paging file information:
            objShellApp.Exec("reg add ""HKLM\System\CurrentControlSet\Control\Session Manager\Memory Management"" /v PagingFiles /t REG_MULTI_SZ /d """ & strPageFileNameInput & " " & strPageFileSizeInput & " " & strPageFileSizeInput & """ /f")
                
                '// Check the return to make sure we succeeded - otherwise, tell the user why we didn't:
                If Not Err.Number = 0 Then
                    gErrData = gErrData & vbCrLf & "Error writing to registry - reason: " & Err.Number & "  - " & Err.Description
                    WScript.Echo gErrData
                    Err.Clear
                Else
                    WScript.Echo "Registry edit to add " & strPageFileNameInput & " as size " & strPageFileSizeInput & "MB was successful."
                    bRebootNeeded = True
                End If
            
            '// If we've made changes that have succeeded, we need to reboot - otherwise, do nothing:
            If bRebootNeeded = True Then
                RebootSystem()
                WScript.Quit
            Else
                WScript.Echo "No changes made that require a reboot.  Exiting script."
                WScript.Quit
            End If
        
        '// If the user left the input blank, delete the paging file - note that Delete and DeleteEx from Win32_PagingFile are deprecated, and
        '// while they'll return 0 on Windows 7, they don't actually delete the paging file.  Using reg add instead, as it works just fine:
        Else
            WScript.Echo "Deleting paging file: " & objDynamicPageFileItem.Name
            objShellApp.Exec("reg add ""HKLM\System\CurrentControlSet\Control\Session Manager\Memory Management"" /v PagingFiles /t REG_MULTI_SZ /d """" /f")
            
            '// Check the return to make sure we succeeded - otherwise, tell the user why we didn't:
            If Not Err.Number = 0 Then
                gErrData = gErrData & vbCrLf & "Error writing to registry - reason: " & Err.Number & "  - " & Err.Description
                WScript.Echo gErrData
                Err.Clear
            Else
                WScript.Echo "Registry edit to remove " & objDynamicPageFileItem.Name & " was successful."
                bRebootNeeded = True
            End If
        End If
    Next
End Sub


Sub RebootSystem()
    WScript.Echo "The system will reboot in 5 seconds..."
    Set isRunning = objShellApp.Exec("shutdown /r /t 5 /f /d p:2:4")
    '// As long as shutdown.exe is running, wait:
    Do While isRunning.Status = 0
        WScript.Sleep 100
        execOutput = isRunning.StdOut.ReadAll
    Loop
End Sub


Function UserInput(strInput)
    WScript.StdOut.Write strInput & " "
    UserInput = WScript.StdIn.ReadLine
End Function


On Error GoTo 0


Sub RunMeWithCScript()
    Dim ScriptEngine, engineFolder, Args, arg, scriptName, argString, scriptCommand
    
    ScriptEngine = UCase(Mid(WScript.FullName, InstrRev(WScript.FullName, "\") + 1))
    engineFolder = Left(WScript.FullName, InstrRev(WScript.FullName, "\"))
    argString = ""
    
    If ScriptEngine = "WSCRIPT.EXE" Then
        Dim Shell
        Set Shell = CreateObject("WScript.Shell")
        Set Args = WScript.Arguments
        
        For Each arg in Args
            If InStr(arg, " ") > 0 Then arg = """" & arg & """"
            argString = argString & " " & Arg
        Next
        
        scriptCommand = "cmd.exe /k " & engineFolder & "cscript.exe """ & WScript.ScriptFullName & """" & argString
        
        Shell.Run scriptCommand, , False
        WScript.Quit
    Else
        Exit Sub
    End If
End Sub

Attached Files


MCTS Windows Internals, MCITP Server 2008 EA, MCTS MDT/BDD, MCSE/MCSA Server 2003, Server 2012, Windows 8
--------------------
Please read the rules before posting!
Please consider donating to MSFN to keep it up and running!

#18
FlierMate

FlierMate

    End User

  • Member
  • Pip
  • 68 posts
  • OS:Windows 7 x86
  • Country: Country Flag
Description: My own compression technology identical to RLE (Run-Length Encoding) using frequency table with low compression ratio.

Title:Squeeze-Together(im) Compression Technology
Researched and Developed by Boo Khan Ming

Purpose:Compress all types of file regardless of file size.

Functions:function SqueezeFile(InputFileName,OutputFileName:string):byte;
function StretchFile(InputFileName,OutputFileName:string):byte;


Programming Language: Turbo Pascal

Attached Files



#19
FlierMate

FlierMate

    End User

  • Member
  • Pip
  • 68 posts
  • OS:Windows 7 x86
  • Country: Country Flag
Description: Converts plain text file to self-displaying .COM program.
There are similar converters out there, but I reinvent the wheel.


Note: Make sure your text file does not contain the dollar sign. (As "$" is reserved as the terminator string)

How It Works:
The equivalent assembly instruction code is as follows:

(0eh in length)
push cs
pop ds
mov dx, 014b ;this is the offset in current COM image block (100h)
mov ah, 09
int 21
mov ax, 4c00 ;zero exit code
int 21
.
<Compiler ID> (3ah in length)
.
<String segment starts here>
.
.
<Terminator string - $>


Programming Language: Turbo Pascal and/or Assembly Language

Attached Files


Edited by FlierMate, 13 November 2011 - 07:42 AM.


#20
FlierMate

FlierMate

    End User

  • Member
  • Pip
  • 68 posts
  • OS:Windows 7 x86
  • Country: Country Flag
Description: Wait For a Mouse Event (Useful for Your Batch Programming)
Screenshot: Please follow step-by-step as the screenshot shown below:

Note:DEBUG is a native DOS command.Attached File  CLICK.GIF   9.59KB   25 downloads

You will notice new CLICK.COM file in the directory.
After you run this tiny program, you have to click using your left mouse button on any part of the screen in order to continue (or return to command prompt)

Programming Language: Assembly Language

#21
FixitUP

FixitUP

    Newbie

  • Banned
  • 47 posts
  • OS:XP Pro x86
  • Country: Country Flag
Batch file for timing scripts, etc.

:: HowLong.bat Timer for execution time for scripts, bat files, etc.
:: Wednesday, January 16, 2013 mousio,Magnum,
:: ** See notes within the script
::
call :StartTimer
::
:: Add what you want to time here
::

@echo off
setlocal disableDelayedExpansion
set "searchRoot=."
:: Set your file search pattern here
set "fileMask=s*.bat"

set "prior=noMatch"
for /f "tokens=1,2 delims=?" %%A in (
'(for /r "%searchRoot%" %%F in ("%fileMask%"^) do @echo %%~zF:%%~nxF?%%~fF^)^|sort'
) do (
set "current=%%A"
setlocal enableDelayedExpansion
if !prior! equ !current! (
if defined priorFile (
echo(
echo !priorFile!
)
endlocal
echo %%B
set "priorFile="
) else (
endlocal
set "prior=%%A"
set "priorFile=%%B"
)
)

call :StopTimer
call :DisplayTimerResult
pause
goto :EOF

:StartTimer
:: Store start time
set StartTIME=%TIME%
for /f "usebackq tokens=1-4 delims=:., " %%f in (`echo %StartTIME: =0%`) do set /a Start100S=1%%f*360000+1%%g*6000+1%%h*100+1%%i-36610100
goto :EOF

:StopTimer
:: Get the end time
set StopTIME=%TIME%
for /f "usebackq tokens=1-4 delims=:., " %%f in (`echo %StopTIME: =0%`) do set /a Stop100S=1%%f*360000+1%%g*6000+1%%h*100+1%%i-36610100
:: Test midnight rollover. If so, add 1 day=8640000 1/100ths secs
if %Stop100S% LSS %Start100S% set /a Stop100S+=8640000
set /a TookTime=%Stop100S%-%Start100S%
set TookTimePadded=0%TookTime%
goto :EOF

:DisplayTimerResult
:: Show timer start/stop/delta
echo Started: %StartTime%
echo Stopped: %StopTime%
echo Elapsed: %TookTime:~0,-2%.%TookTimePadded:~-2% seconds
goto :EOF

#22
jeff.sadowski

jeff.sadowski

    Junior

  • Member
  • Pip
  • 76 posts
I post this in the hopes that it will be usefull
' The goal of this tools is to read a .reg file and generate a .xml that should allow us to set those settings thru GPO on Windows Server 2012

' +-----------------------------------------------------------------------------+
' | App.Name :	REG2XML.vbs                                                     |
' | App.Description :                                                           |
' |                     This tools reads a .reg file and generates a XML        |
' | file that should allow us to set those settings thru GPO                    |
' |                     This file accepts 1 parameter:                          |
' |                         1) Reg File to convert                              |
' |                                                                             |
' |                     The output file will be named after the .REG file (if   |
' | the input is myfile.REG, the output will be myfile.xml)                     |
' |                     The XML output file will be saved in a subfolder of     |
' | the one the .REG file is located.                                           |
' |                     So, if the reg file is C:\myapp\myfile.reg then         |
' | the XML file will be as in C:\myAPP\myfile.xml                              |
' |                                                                             |
' | Current Version:	1.02                                                    |
' |              By:    Jeff Sadowski                                           |
' | Thanks to: Mcosentino                                                       |
' |                     I used his REG_2_admx as a way of learning a bit of this|
' |            Date:        May 31 2013                                         |
' |                                                                             |
' | I did not do exclusive testing there may be bugs                            |
' |                                                                             |
' | I created a key of each type and exproted the reg file and then used the    |
' | wizard to put them in the GPO then exported the XML and did my best to match|
' | the xml from the reg file                                                   |
' +- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -+
' | Bugs                                                                        |
' | Fixed issue with Default                                                    |
' | Fixed double backslash behavior                                             |
' | Fixed backslash quote behavior                                              |
' +- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -+
' |                                                                             |
' | How to use it:                                                              |
' |       cscript REG2XML.vbs <Registry file>                                   |
' |     Sample:                                                                 |
' |       cscript REG2XML.vbs c:\myapp\myfile.reg                               |
' |                                                                             |
' |  Alternatively drag your reg file on to this script in the file browser will|
' |  do the same thing                                                          |
' +-----------------------------------------------------------------------------+


dim Hive, Key, filename, xmldoc, xmlroot, FSO, previouskeyparts, xmllevels, objTextFile, strLine, sTempLine, data

Hive=""
Key=""
set FSO = createobject("Scripting.FileSystemObject")

if wscript.Arguments.Count < 1 then
 wscript.echo "Missing Parameters:" & vbcrlf & _
              "Usage:"  & vbcrlf & vbtab & _
              "cscript " & WScript.ScriptName & " <Registry file>"  & vbcrlf  & _
              "  Sample:" & vbcrlf & vbtab  & _
              "cscript " & WScript.ScriptName & " c:\myapp\myfile.reg"
	wscript.quit
else
    filename=Wscript.Arguments.Item(0)
end if

Set xmldoc = CreateObject("MSXML.DOMDocument")
Set xmlroot = xmldoc.createElement("Collection")

previouskeyparts=Array()
xmllevels=Array(xmlroot)

xmldoc.createAttribute("name")
xmldoc.appendChild xmlroot
addAttrib xmlroot,"clsid","{53B533F5-224C-47e3-B01B-CA3B3F3FF4BF}"

Set objTextFile = FSO.OpenTextFile(filename , 1,, -2)
Do While objTextFile.AtEndOfStream <> True
	sTempLine = objtextFile.ReadLine
	Do While (Right(sTempLine, 1) = "\" and objTextFile.AtEndOfStream <> True)
		sTempLine = Left(sTempLine,Len(sTempLine)-1) & LTrim(objtextFile.ReadLine)
	Loop
	strLine = Trim(sTempLine)
	If left(strLine, 1) = "[" Then
		addKey(strLine)
	elseif left(strLine, 1) = """" or left(strLine,1) = "@" Then
		addElement(strLine)
	end if
Loop
objtextFile.Close

xmldoc.save replace(lcase(filename),".reg",".xml")

function addKey(fullkeyname)
 dim keyname,keynameparts,x
 'wscript.echo fullkeyname
 keyname=Mid(Trim(fullkeyname),2,len(fullkeyname)-2)
 keynameparts=Split(keyname,"\")
 Hive=keynameparts(0)
 Key=Mid(Trim(fullkeyname),len(Hive)+3,len(fullkeyname)-(len(Hive)+3))
 if UBound(previouskeyparts) = -1 then
  for each part in keynameparts
   addkey_helper(part)
  next
 else
  x=0
  do while x < UBound(keynameparts) and x < UBound(previouskeyparts) and keynameparts(x) = previouskeyparts(x)
   x=x+1
  loop
  redim preserve xmllevels(x)
  x=x-1
  do while x < UBound(keynameparts)
   x=x+1
   addkey_helper(keynameparts(x))
  loop
 end if
 previouskeyparts=keynameparts 
end function

function addkey_helper(name)
 redim preserve xmllevels(UBound(xmllevels)+1)
 set xmllevels(UBound(xmllevels)) = xmldoc.createElement("Collection")
 xmllevels(UBound(xmllevels)-1).appendChild xmllevels(UBound(xmllevels))
 addAttrib xmllevels(UBound(xmllevels)),"clsid","{53B533F5-224C-47e3-B01B-CA3B3F3FF4BF}"
 addAttrib xmllevels(UBound(xmllevels)),"name",name
end function

function addElement(fullelement)
 dim tempObj, tempObj2, tempObj3, tempObj4, tempObj5, keyvalue, character, prevchar, prevchar2, prevchar3, value, values, name, innername
 set tempObj = xmldoc.createElement("Registry")
 set tempObj2 = xmldoc.createElement("Properties")

 keyvalue=Split(fullelement,"=")
 if Left(keyvalue(0),1) = "@" then
  name="(Default)"
  innername=""
  addAttrib tempObj2,"default","1"
 else
  name=Mid(keyvalue(0),2,Len(keyvalue(0))-2)
  innername=name
 end if
 addAttrib tempObj,"clsid","{9CD4B2F4-923D-47f5-A062-E897DD1DAD50}"
 addAttrib tempObj,"name",name
 addAttrib tempObj2,"hive",Hive
 addAttrib tempObj2,"key",Key
 addAttrib tempObj2,"name",innername
 if Left(keyvalue(1),1) = """" then
  addAttrib tempObj,"image","7"
  addAttrib tempObj2,"type","REG_SZ"
  value=Replace(Replace(Mid(keyvalue(1),2,Len(keyvalue(1))-2),"\""",""""),"\\","\")
 elseif Left(keyvalue(1),4) = "hex:" then
  addAttrib tempObj,"image","17"
  addAttrib tempObj2,"type","REG_BINARY"
  value=Replace(Right(keyvalue(1),Len(keyvalue(1))-4),",","")
 elseif Left(keyvalue(1),6) = "dword:" then
  addAttrib tempObj,"image","12"
  addAttrib tempObj2,"type","REG_DWORD"
  value=Replace(Right(keyvalue(1),Len(keyvalue(1))-6),",","")
 elseif Left(keyvalue(1),7) = "hex(<img src='http://www.msfn.org/board/public/style_emoticons/<#EMO_DIR#>/cool.gif' class='bbc_emoticon' alt='B)' />:" then
  addAttrib tempObj,"image","12"
  addAttrib tempObj2,"type","REG_QWORD"
  data=split(Right(keyvalue(1),Len(keyvalue(1))-7),",")
  for each part in data
   value=part & value
  next
 elseif Left(keyvalue(1),7) = "hex(7):" then
  values=Array()
  addAttrib tempObj,"image","7"
  addAttrib tempObj2,"type","REG_MULTI_SZ"
  data=split(Right(keyvalue(1),Len(keyvalue(1))-7),",")
  for each part in data
   character=CInt("&H" & part)
   if prevchar = 0 and prevchar2 = 0 and character = 0 and prevchar3 <> 0 then
    redim preserve values(UBound(values)+1)
    values(UBound(values))=value
    value=""
   end if
   if character <> 0 then
    value=value & Chr(character)
   end if
   prevchar3=prevchar2
   prevchar2=prevchar
   prevchar=character
  next
  set tempObj3 = xmldoc.createElement("Values")
  for each part in values
   set tempObj4 = xmldoc.createElement("Value")
   set tempObj5 = xmldoc.createTextNode(part)
   tempObj4.appendChild tempObj5
   tempObj3.appendChild tempObj4
  next
  tempObj2.appendChild tempObj3
  value=Join(values," ") & " "
 elseif Left(keyvalue(1),7) = "hex(2):" then
  addAttrib tempObj,"image","7"
  addAttrib tempObj2,"type","REG_EXPAND_SZ"
  data=split(Right(keyvalue(1),Len(keyvalue(1))-7),",")
  for each part in data
   character=CInt("&H" & part)
   if character <> 0 then
    value=value & Chr(character)
   end if
  next
 else
  value=keyvalue(1)
 end if
 addAttrib tempObj2,"value",value
 tempObj.appendChild tempObj2
 xmllevels(UBound(xmllevels)).appendChild tempObj
end function

function addAttrib(byref obj,byval key,byval val)
 dim attrib
  set attrib = xmldoc.createAttribute(key)
  attrib.appendChild(xmldoc.createTextNode(val))
  obj.Attributes.setNamedItem(attrib)
end function

Edited by jeff.sadowski, 03 June 2013 - 10:25 AM.


#23
dencorso

dencorso

    Adiuvat plus qui nihil obstat

  • Super Moderator
  • 5,782 posts
  • OS:98SE
  • Country: Country Flag

Donator

Purpose: to delete all $RECYCLE.BIN (aka Recycle Bin.BIN) folders across all fixed partitions in a machine.
Language: batch script

Introduction: Multibooting on machines using mainly FAT filesystems can lead to the Recycle Bin.BIN issue... This is a clean-up script aiming at removing those annoying extra folders, across all the partitions marked as non-removable in a given machine.

Requirements: unix classic colrm.exe (findable inside util-linux-ng-2.14.1-bin.zip) and Uwe Sieber's ListDOSDevices.exe (findable here).
 
I call it DelBinBin.cmd and it's pretty simple, although I bet it can be made still simpler:


@echo off
for /F "tokens=*" %%1 in ('listdosdevices ^| find /i "fixed" ^| colrm 3') do RD /S /Q "%%1\$Recycle.BIN" 2> nul

Later addition:

Yzöwl has devised an interesting alternative option for achieving the same result from XP or later, without requiring the use of any 3rd party tools:

@For /f "tokens=2 delims==:" %%# In (
    'Wmic LogicalDisk Where "DriveType=3" Get DeviceID /value'
    ) do @RD/s/q %%#:\$Recycle.BIN

Thanks a lot, Yzöwl. You do rock! :thumbup

 






0 user(s) are reading this topic

0 members, 0 guests, 0 anonymous users



How to remove advertisement from MSFN