pcuser_tom

LLXX, I know this is an old thread but I was wondering if you'd be willing to share your ASM code and send it to me via email. I'm using ThunderVB to add inline ASM to some of my VB programs and it would be great to be able to use an MD5 function coded in ASM without using an external dll.

Thank you jcarle

I'm trying to convert this simple vb6 code to ASP but I just can't figure out how to do it. Open File1 For Binary As 1 Open File2 For Binary As 2 For i = 1 To LOF(1) Get #1, , mybyte ' Manipulate mybyte here Put #2, , mybyte Next Close 2 Close 1 How do I read/write a binary file in ASP? Tom

What programming languages are you familiar with? HERE'S an example vb6 project that shows you how to start and stop a specific program. Add a timer control and you should atleast have enough to get you headed in the right direction.

This one really has me stumped! SubinACL seems to be the only way I've seen to be able to take ownership of this key. The SetPerm example is the closest I've found but it seems to use the same method as regedit which results in "access denied". Does anyone know of a good api spy program that will show me the functions that subinacl uses to accomplish this?

You can download any file using this simple code: Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long Private Sub Command1_Click() URLDownloadToFile 0, "http://www.yoursite.com/yourfile.txt", App.Path & "\" & "yourfile.txt", 0, 0 End Sub The first param is the URL and file to download and the second param is where you want to save it to.

Thank you, expect an email from PCUSER. My project is working great but I'd love to see you're implementation even if it's just for knowledge. I have it hashing 100+ mb (around 4,500 files) in about 30 seconds now with no dll's or external depends but I'm curious to see the algorithm used in your dll. Tom

I'm trying to figure out how to set registry permissions using the win32 api via vb6 but I'm not getting anywhere very fast. The problem is that some Dell oem xp cd's have a controlset001\services\iastor key that has 2 unknown/bogus DACL's set to: OWNER = S-1-5-21-846617511-297957836-1346600456-1005 GROUP = S-1-5-21-846617511-297957836-1346600456-513 If you mount the i386\setupreg.hiv in regedit and navigate to the iastor key, you get "Access Denied" and it causes trouble when building with BartPE. I would like to clear those SID's from the ACL and add the administrators group (S-1-5-32-544) and my own owner (currently logged in user). SubInAcl does this just fine using this from the commandline (uses the security attribs from it's parent key): subinacl /subkeyreg hkey_local_machine\dell\controlset001\services\iastor\ /objectcopysecurity=hkey_local_machine\dell\controlset001\services so I know it can be done (.NET is not an option). Any help would be greatly appreciated. Tom

I found a better solution than what I was trying to do HERE. Hopefully it'll help someone else out that's looking for a good MD5 routine in VB6. It uses the builtin function of advapi.dll and is very fast. Thanks for all the help and suggestions Tom

no If I admit it, will you help me figure out what I'm doing wrong in my code?

Here's the example C++ program with the DigestFile( char *szFName ) function that I'm trying to convert to vb. #include "mdx.h" #include <stdlib.h> #include <stdio.h> #include <string.h> // READLEN % 64 must = 0 #define READLEN 1048576L // 2^20, 1MB void DigestFile( char * ); void DigestString(); void main(int argc, char *argv[]) { printf("%s\n\n", MDxGetVersion()); if( argc > 1 ) DigestFile( argv[1] ); else DigestString(); } /* I use the 'chunk' method for processing files not because of limitations of my dll, but think what would happen if you tried to load an entire cd image into memory. */ void DigestFile( char *szFName ) { FILE *file; void *lpData; long flen, mlen; MDxSum mdDataSum; MDxSum md4DataSum; // the 64 is for padding purposes lpData = malloc( READLEN + 64 ); printf( "MD4/5 Digests of \"%s\":\n", szFName ); file = fopen( szFName, "rb" ); if( file == NULL ) { printf("ERROR: File not found.\n"); return; } MDxInit( &mdDataSum ); MDxInit( &md4DataSum ); fseek( file, 0, SEEK_END ); //Get the file length flen = mlen = ftell( file ); fseek( file, 0, SEEK_SET ); // When it takes a while to process a large file, // remember that for each chunk it has to run // through the main translation loop 16384 times! printf("Processing %ld byte file: .", flen ); while( flen > READLEN ) { if( fread( lpData, 1, READLEN, file ) != READLEN) { printf("READ ERROR!\n"); return; } MD5Translate( lpData, READLEN, &mdDataSum ); MD4Translate( lpData, READLEN, &md4DataSum ); flen -= READLEN; printf("."); } if (fread( lpData, 1, flen, file ) != flen) { printf("READ ERROR!\n"); return; } // This is why I added the new argument to MDxPad // So we can pass the length of the data AND the // Total length of the message // Also it now returns the # of padding bytes added, // this is for files that are an exact multiple of the chunk // length. (Otherwise the padding isn't Translated) flen += MDxPad( lpData, flen, mlen ); MD5Translate( lpData, flen, &mdDataSum ); MD4Translate( lpData, flen, &md4DataSum ); // New step necessary because of the 'chunking' method MDxFinalize( &mdDataSum ); MDxFinalize( &md4DataSum ); printf("\nMD4: %08x%08x%08x%08x\n", md4DataSum.dwSum[0], md4DataSum.dwSum[1], md4DataSum.dwSum[2], md4DataSum.dwSum[3]); printf("MD5: %08x%08x%08x%08x\n", mdDataSum.dwSum[0], mdDataSum.dwSum[1], mdDataSum.dwSum[2], mdDataSum.dwSum[3]); fclose(file); } void DigestString() { //For our demo purposes, no strings bigger than 1024 :) unsigned char lpData[1024] = ""; long len = 0; MDxSum mdDataSum; printf("Enter the string to digest: "); scanf("%s", &lpData ); len = strlen(lpData); // Have to do this before the Padding...well...it's best anyway;) printf( "MD4/5 Digests of \n\"%s\":\n", lpData ); // For the strings, we're gonna pad and digest the string // in one pass. MDxInit( &mdDataSum ); MDxPad( lpData, len, len ); MD5Translate( lpData, len, &mdDataSum ); // New step necessary because of the 'chunking' method MDxFinalize( &mdDataSum ); printf("MD5: %08x%08x%08x%08x\n", mdDataSum.dwSum[0], mdDataSum.dwSum[1], mdDataSum.dwSum[2], mdDataSum.dwSum[3]); MDxInit( &mdDataSum ); MD4Translate( lpData, len, &mdDataSum ); printf("MD4: %08x%08x%08x%08x\n", mdDataSum.dwSum[0], mdDataSum.dwSum[1], mdDataSum.dwSum[2], mdDataSum.dwSum[3]); return; } and the include file: #ifndef __windows_h__ typedef unsigned long DWORD; #define STDCALL _stdcall #endif typedef struct { DWORD dwSum[4]; }MDxSum; DWORD STDCALL MDxPad ( unsigned char *, unsigned long, unsigned long ); void STDCALL MDxInit( MDxSum * ); void STDCALL MD5Translate( unsigned char *, long, MDxSum * ); void STDCALL MD4Translate( unsigned char *, long, MDxSum * ); const char * STDCALL MDxGetVersion(); void STDCALL MDxFinalize( MDxSum * );

Thanks for sharing your code Tarun. I haven't tried it yet but I already have an md5 module but it's way too slow. I'm going to be hashing about 4,000 files and some of them are 5-8mb in size. I try out your module though.

The MDxPad function pads the string to be divisable by 64 (and returns the number of bytes that it padded) so it shouldn't matter if you pass it 30000, 32768 or 3. A string in vb has a maximum value of 32768 so that's what I'm stuck with but that's ok. I already have a vb routine that shells out to md5deep and captures the output but doing it like that is painfully slow, that's why I was looking for a dll to use as an alternative. BTW. 30k isn't the same as 30kb Thanks again for the help.

paraglider pointed me in the right direction on another forum. I had to change: Dim lpData as String to Dim lpData as String * 30000 The above function is working fine now and produces an md5 hash for files (under 30k) as fast as I can feed them to it I wanted to make sure the basic function was working with entire smaller files before moving on to splitting larger files and processing the chunks. Now I'm having trouble with it not returning the correct md5 hash for larger files that were processed in chunks. Here's the entire vb6 form that includes the all the code. Private Declare Function MD4Translate Lib "mdx.dll" (ByVal MyString As String, ByVal MyLong As Long, ByRef MySum As MDxSum) As Long Private Declare Function MD5Translate Lib "mdx.dll" (ByVal MyString As String, ByVal MyLong As Long, ByRef MySum As MDxSum) As Long Private Declare Function MDxFinalize Lib "mdx.dll" (ByRef MySum As MDxSum) As Long Private Declare Function MDxGetVersion Lib "mdx.dll" () As Long Private Declare Function MDxInit Lib "mdx.dll" (ByRef MySum As MDxSum) As Long Private Declare Function MDxPad Lib "mdx.dll" (ByVal MyString As String, ByVal MyLong As Long, ByVal MyLong As Long) As Long Private Type MDxSum dwSum(3) As Long End Type Dim md5DataSum As MDxSum Dim lpData As String * 30000 Dim MyFile As String Private Function GetHash(fName As String) MyFile = fName MDxInit md5DataSum If FileLen(MyFile) = 0 Then Exit Function If FileLen(MyFile) <= 30000 Then ' The file is less than or equal to 30k Open MyFile For Binary As #1 lpData = Input(LOF(1), 1) Close #1 DoEvents MDxInit md5DataSum MDxPad lpData, FileLen(MyFile), FileLen(MyFile) MD5Translate lpData, FileLen(MyFile), md5DataSum MDxFinalize md5DataSum GetHash = Hex(md5DataSum.dwSum(0)) & Hex(md5DataSum.dwSum(1)) & Hex(md5DataSum.dwSum(2)) & Hex(md5DataSum.dwSum(3)) Exit Function End If If FileLen(MyFile) > 30000 Then ' The file is greater that 30k - process it in 30k chunks Open MyFile For Binary As #1 For i = 1 To LOF(1) Step 30000 DoEvents If LOF(1) >= i + 30000 Then lpData = Input(30000, 1) MD5Translate lpData, Len(lpData), md5DataSum Else ' There's less than 30k until the end of the file so ' pad it then call translate one more time then finish up MDxPad lpData, Len(lpData), FileLen(MyFile) MD5Translate lpData, Len(lpData), md5DataSum MDxFinalize md5DataSum GetHash = Hex(md5DataSum.dwSum(0)) & Hex(md5DataSum.dwSum(1)) & Hex(md5DataSum.dwSum(2)) & Hex(md5DataSum.dwSum(3)) Close #1 Exit Function End If Next End If End Function Private Sub Form_Load() MsgBox GetHash("C:\ntdetect.com") End End Sub I'm sure it's something simple that I didn't translate correctly from the sample C++ program in the download but I can't figure out what it is. Any ideas? Thanks for the link to the .NET code, I'm sure I'll be using it for alot of other projects that need a MD5 routine but this one can't be .NET and will need to be ran from PE/BartPE as well as windows. Thanks for the help and suggestions so far.

I've been trying to write a routine in VB that calculates an md5 hash for every file in a directory and all sub directories and outputs the results into a txt file. VB is WAY to slow to do anything like this but I found a dll called mdx.dll written in assembler by RudeBoy and is lightning fast! You can download his source files and binary dll HERE The zip file includes an example C++ program to demonstrate how to use the dll. I made a vb6 module to interface the dll and it works great to calculate the md5 for a single file. My problem is that I'm usung FindFirstFile and FindNextFile api's to enumerate files very fast and feed them to the the function and it crashes the dll. Here's my VB6 module to interface the dll. Private Declare Function MD4Translate Lib "mdx.dll" (ByVal MyString As String, ByVal MyLong As Long, ByRef MySum As MDxSum) As Long Private Declare Function MD5Translate Lib "mdx.dll" (ByVal MyString As String, ByVal MyLong As Long, ByRef MySum As MDxSum) As Long Private Declare Function MDxFinalize Lib "mdx.dll" (ByRef MySum As MDxSum) As Long Private Declare Function MDxGetVersion Lib "mdx.dll" () As Long Private Declare Function MDxInit Lib "mdx.dll" (ByRef MySum As MDxSum) As Long Private Declare Function MDxPad Lib "mdx.dll" (ByVal MyString As String, ByVal MyLong As Long, ByVal MyLong As Long) As Long Type MDxSum dwSum(3) As Long End Type Dim MyFile As String Dim md5DataSum As MDxSum Dim lpData As String Public Function GetHash(fName As String) MyFile = fName MDxInit md5DataSum If FileLen(MyFile) = 0 Then Exit Function Open MyFile For Binary As #1 If FileLen(MyFile) <= 30000 Then lpData = Input(LOF(1), 1) MDxPad lpData, FileLen(MyFile), FileLen(MyFile) MD5Translate lpData, FileLen(MyFile), md5DataSum MDxFinalize md5DataSum GetHash = Hex(md5DataSum.dwSum(0)) & Hex(md5DataSum.dwSum(1)) & Hex(md5DataSum.dwSum(2)) & Hex(md5DataSum.dwSum(3)) Close #1 Exit Function End If Close #1 End Function This code works great to hash a single file but crashes if I feed files to it too fast. BTW. It currently only hashes files less than 30k so it can read the entire file at one time. Can anyone compare my vb code to the sample C++ program that's included in the download to see what I'm doing wrong? I also want to add the ability to "chunk" larger files but I need to figure out what I'm doing wrong with the basic function first. Tom

I'm the author of EzPcFix. Take a look at the documentation on the webpage and see if the "Reg Values" section will do what you want, it allows you to specify reg values in an inf file for settings that you'll want to be able to change for each user and displays a window that allows you to change that setting for each user on the system (individually). Hopefully EzPcFix can do what you want but PM me if you want a customized app coded for you. Tom

I answered my own question but my journey to figure this out has led me to believe that nobody really knows how to do this and I'm posting the code so it'll be public knowledge from now on... Make a new vb6 project with these controls: Command1 Option1 (caption=static) Option2 (caption=dhcp) Label1 (caption=IP Address) Label2 (caption=Netmask) Label3 (caption=Gateway) Label4 (caption=DNS Server) Text1 (caption=IP Address) Text2 (caption=Netmask) Text3 (caption=Gateway) Text4 (caption=DNS Server) frmMain ' ***************************************************************************************** ' This example uses a VERY undocumented function in iphlpapi.dll * ' called "SetAdapterIPAddress". This function accepts 5 parameters * ' (1 string value and 4 DWORD values). Since DWORD isn't a supported * ' data type in vb, we have to declare it as long with ByVal. * ' * ' PARAMETER-1 is a String value for the network adapter GUID which can be found * ' in the registry at * ' "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Interfaces" * ' * ' PARAMETER-2 is a DWORD value that can be either 0 or 1 to indicate whether or not * ' DHCP is to be used * ' * ' PARAMETER-3 is a DWORD value for the IP Address (already converted to long). IF * ' DHCP won't be used then it should be set to vbNull * ' * ' PARAMETER-4 is a DWORD value for the Netmask (already converted to long). IF * ' DHCP won't be used then it should be set to vbNull * ' * ' PARAMETER-5 is a DWORD value for the Gateway (already converted to long). IF * ' DHCP won't be used then it should be set to vbNull * ' * ' The only problem is that this function doesn't modify or set the DNS Server address * ' but the good news is that all we have to do is change the value in the registry at * ' "HKLM\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Interfaces\(guid)\NameServer" * ' If you're using DHCP then this has to be changed before calling SetAdapterIPAddress * ' or the old DNS value won't be changed. * ' * ' Change MyGUID in the Command1_Click event to match your network adapter * ' * '****************************************************************************************** Private Declare Function SetAdapterIPAddress Lib "Iphlpapi" Alias "#135" (ByVal szAdapterGUID As String, ByVal dwDHCP As Long, ByVal dwIP As Long, ByVal dwMask As Long, ByVal dwGateway As Long) As Long ' Structure to hold all four bytes of the IP address. Private Type myBytes B1 As Byte B2 As Byte B3 As Byte B4 As Byte End Type ' Structure to copy to/from using LSet. Private Type myLong Val As Long End Type ' Convert a dotted quad IP string to a Long. Private Function IP2Long(IP As String) As Long ' Perhaps the bytes are not in the politically correct order, ' but as long as you undo it with Long2IP you'll be fine. ReDim parse(0 To 3) As String Dim B As myBytes Dim L As myLong parse = Split(IP, ".") B.B1 = Val(parse(0)) B.B2 = Val(parse(1)) B.B3 = Val(parse(2)) B.B4 = Val(parse(3)) LSet L = B IP2Long = L.Val End Function Private Sub Command1_Click() Dim MyGUID As String Dim DoDHCP As Integer Dim MyIP As String Dim MyNetMask As String Dim MyGateway As String Dim MyDNS As String MyGUID = "{6D89D9xx-DDCx-423x-86xx-1DDB3A057xxx}" Screen.MousePointer = vbHourglass ' Static If Option1.Value = True Then DoDHCP = 0 MyIP = IP2Long(Text1.Text) MyNetMask = IP2Long(Text2.Text) MyGateway = IP2Long(Text3.Text) SetKeyValue "SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Interfaces\" & MyGUID, "NameServer", Text4.Text, REG_SZ Else ' DHCP DoDHCP = 1 MyIP = vbNull MyNetMask = vbNull MyGateway = vbNull SetKeyValue "SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Interfaces\" & MyGUID, "NameServer", "", REG_SZ End If DoIT = SetAdapterIPAddress(MyGUID, DoDHCP, MyIP, MyNetMask, MyGateway) Screen.MousePointer = vbDefault MsgBox "Done" End Sub Private Sub SetKeyValue(sKeyName As String, sValueName As String, _ vValueSetting As Variant, lValueType As Long) Dim lRetVal As Long 'result of the SetValueEx function Dim hKey As Long 'handle of open key 'open the specified key lRetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, sKeyName, 0, _ KEY_SET_VALUE, hKey) lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting) RegCloseKey (hKey) End Sub Private Sub Option1_Click() Text1.Enabled = True Text2.Enabled = True Text3.Enabled = True Text4.Enabled = True End Sub Private Sub Option2_Click() Text1.Enabled = False Text2.Enabled = False Text3.Enabled = False Text4.Enabled = False End Sub modRegistry Option Explicit Public Const REG_SZ As Long = 1 Public Const REG_DWORD As Long = 4 Public Const HKEY_CLASSES_ROOT = &H80000000 Public Const HKEY_CURRENT_USER = &H80000001 Public Const HKEY_LOCAL_MACHINE = &H80000002 Public Const HKEY_USERS = &H80000003 Public Const ERROR_NONE = 0 Public Const ERROR_BADDB = 1 Public Const ERROR_BADKEY = 2 Public Const ERROR_CANTOPEN = 3 Public Const ERROR_CANTREAD = 4 Public Const ERROR_CANTWRITE = 5 Public Const ERROR_OUTOFMEMORY = 6 Public Const ERROR_ARENA_TRASHED = 7 Public Const ERROR_ACCESS_DENIED = 8 Public Const ERROR_INVALID_PARAMETERS = 87 Public Const ERROR_NO_MORE_ITEMS = 259 Public Const KEY_QUERY_VALUE = &H1 Public Const KEY_SET_VALUE = &H2 Public Const KEY_ALL_ACCESS = &H3F Public Const REG_OPTION_NON_VOLATILE = 0 Declare Function RegCloseKey Lib "advapi32.dll" _ (ByVal hKey As Long) As Long Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias _ "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _ ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions _ As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes _ As Long, phkResult As Long, lpdwDisposition As Long) As Long Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias _ "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _ ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As _ Long) As Long Declare Function RegQueryValueExString Lib "advapi32.dll" Alias _ "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _ String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _ As String, lpcbData As Long) As Long Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias _ "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _ String, ByVal lpReserved As Long, lpType As Long, lpData As _ Long, lpcbData As Long) As Long Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias _ "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _ String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _ As Long, lpcbData As Long) As Long Declare Function RegSetValueExString Lib "advapi32.dll" Alias _ "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _ ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As _ String, ByVal cbData As Long) As Long Declare Function RegSetValueExLong Lib "advapi32.dll" Alias _ "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _ ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, _ ByVal cbData As Long) As Long Public Function SetValueEx(ByVal hKey As Long, sValueName As String, _ lType As Long, vValue As Variant) As Long Dim lValue As Long Dim sValue As String Select Case lType Case REG_SZ sValue = vValue & Chr$(0) SetValueEx = RegSetValueExString(hKey, sValueName, 0&, _ lType, sValue, Len(sValue)) Case REG_DWORD lValue = vValue SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, _ lType, lValue, 4) End Select End Function Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As _ String, vValue As Variant) As Long Dim cch As Long Dim lrc As Long Dim lType As Long Dim lValue As Long Dim sValue As String On Error GoTo QueryValueExError ' Determine the size and type of data to be read lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch) If lrc <> ERROR_NONE Then Error 5 Select Case lType ' For strings Case REG_SZ: sValue = String(cch, 0) lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, _ sValue, cch) If lrc = ERROR_NONE Then vValue = Left$(sValue, cch - 1) Else vValue = Empty End If ' For DWORDS Case REG_DWORD: lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, _ lValue, cch) If lrc = ERROR_NONE Then vValue = lValue Case Else 'all other data types not supported lrc = -1 End Select QueryValueExExit: QueryValueEx = lrc Exit Function QueryValueExError: Resume QueryValueExExit End Function My main goal here was to be able to change from a static IP to dhcp (and back again) from a basic BartPE build where WMI doesn't work and you can't shell out to netsh/ipconfig and a reboot isn't an option. Tom

I've been trying to find a way to set the IP Address in VB6 without WMI or shelling out to netsh and without the need to reboot but I can't figure out how to do it. Iphlpapi.dll has a function called SetAdapterIPAddress but I don't know how to declare it. The "IPChange" sample included in the Platform SDK doesn't replace/change the IP Address, it only adds an additional IP via AddIPAddress. I'm really stumped on this one. Does anyone know how this can be done in VB6? Tom

Here's the vb6 code that shows you how to register FileDisk.sys as a system service and start it without a need to reboot. Just add this module to your project and use RegSVC, StartSVC, StopSVC and UnRegSVC to register, start, stop and unregister FileDisk.sys as a system service. This code assumes that FileDisk.sys is in the same directory. ' Use "RegSVC, StartSVC, StopSVC and UnRegSVC Option Explicit Private Type OSVERSIONINFO dwOSVersionInfoSize As Long dwMajorVersion As Long dwMinorVersion As Long dwBuildNumber As Long dwPlatformId As Long szCSDVersion(1 To 128) As Byte End Type Private Const VER_PLATFORM_WIN32_NT = 2& Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long Private Declare Function ShellExecute Lib "shell32" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long Private Const SW_SHOWNORMAL = 1& Dim ServState As SERVICE_STATE, Installed As Boolean Private Const ERROR_SERVICE_DOES_NOT_EXIST = 1060& Private Const SERVICE_WIN32_OWN_PROCESS = &H10& Private Const SERVICE_KERNEL_DRIVER = &H1& Private Const SERVICE_WIN32_SHARE_PROCESS = &H20& Private Const SERVICE_WIN32 = SERVICE_WIN32_OWN_PROCESS + _ SERVICE_WIN32_SHARE_PROCESS Private Const SERVICE_FILE_SYSTEM_DRIVER = &H2& Private Const SERVICE_ACCEPT_STOP = &H1 Private Const SERVICE_ACCEPT_PAUSE_CONTINUE = &H2 Private Const SERVICE_ACCEPT_SHUTDOWN = &H4 Private Const SC_MANAGER_CONNECT = &H1& Private Const SC_MANAGER_CREATE_SERVICE = &H2& Private Const SC_MANAGER_ENUMERATE_SERVICE = &H4 'Private Const SC_MANAGER_LOCK = &H8 'Private Const SC_MANAGER_QUERY_LOCK_STATUS = &H10 'Private Const SC_MANAGER_MODIFY_BOOT_CONFIG = &H20 Private Const STANDARD_RIGHTS_REQUIRED = &HF0000 Private Const SERVICE_QUERY_CONFIG = &H1& Private Const SERVICE_CHANGE_CONFIG = &H2& Private Const SERVICE_QUERY_STATUS = &H4& Private Const SERVICE_ENUMERATE_DEPENDENTS = &H8& Private Const SERVICE_START = &H10& Private Const SERVICE_STOP = &H20& Private Const SERVICE_PAUSE_CONTINUE = &H40& Private Const SERVICE_INTERROGATE = &H80& Private Const SERVICE_USER_DEFINED_CONTROL = &H100& Private Const SERVICE_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _ SERVICE_QUERY_CONFIG Or _ SERVICE_CHANGE_CONFIG Or _ SERVICE_QUERY_STATUS Or _ SERVICE_ENUMERATE_DEPENDENTS Or _ SERVICE_START Or _ SERVICE_STOP Or _ SERVICE_PAUSE_CONTINUE Or _ SERVICE_INTERROGATE Or _ SERVICE_USER_DEFINED_CONTROL) Private Const SERVICE_AUTO_START As Long = 2 Private Const SERVICE_DEMAND_START As Long = 3 Private Const SERVICE_ERROR_NORMAL As Long = 1 Private Const ERROR_INSUFFICIENT_BUFFER = 122& Private Enum SERVICE_CONTROL SERVICE_CONTROL_STOP = 1& SERVICE_CONTROL_PAUSE = 2& SERVICE_CONTROL_CONTINUE = 3& SERVICE_CONTROL_INTERROGATE = 4& SERVICE_CONTROL_SHUTDOWN = 5& End Enum Public Enum SERVICE_STATE SERVICE_STOPPED = &H1 SERVICE_START_PENDING = &H2 SERVICE_STOP_PENDING = &H3 SERVICE_RUNNING = &H4 SERVICE_CONTINUE_PENDING = &H5 SERVICE_PAUSE_PENDING = &H6 SERVICE_PAUSED = &H7 End Enum Private Type SERVICE_STATUS dwServiceType As Long dwCurrentState As Long dwControlsAccepted As Long dwWin32ExitCode As Long dwServiceSpecificExitCode As Long dwCheckPoint As Long dwWaitHint As Long End Type Private Type QUERY_SERVICE_CONFIG dwServiceType As Long dwStartType As Long dwErrorControl As Long lpBinaryPathName As Long lpLoadOrderGroup As Long dwTagId As Long lpDependencies As Long lpServiceStartName As Long lpDisplayName As Long End Type Private Declare Function OpenSCManager _ Lib "advapi32" Alias "OpenSCManagerA" _ (ByVal lpMachineName As String, ByVal lpDatabaseName As String, _ ByVal dwDesiredAccess As Long) As Long Private Declare Function CreateService _ Lib "advapi32" Alias "CreateServiceA" _ (ByVal hSCManager As Long, ByVal lpServiceName As String, _ ByVal lpDisplayName As String, ByVal dwDesiredAccess As Long, _ ByVal dwServiceType As Long, ByVal dwStartType As Long, _ ByVal dwErrorControl As Long, ByVal lpBinaryPathName As String, _ ByVal lpLoadOrderGroup As String, ByVal lpdwTagId As String, _ ByVal lpDependencies As String, ByVal lp As String, _ ByVal lpPassword As String) As Long Private Declare Function DeleteService _ Lib "advapi32" (ByVal hService As Long) As Long Private Declare Function CloseServiceHandle _ Lib "advapi32" (ByVal hSCObject As Long) As Long Private Declare Function OpenService _ Lib "advapi32" Alias "OpenServiceA" _ (ByVal hSCManager As Long, ByVal lpServiceName As String, _ ByVal dwDesiredAccess As Long) As Long '** Change SERVICE_NAME as needed Private Declare Function QueryServiceConfig Lib "advapi32" _ Alias "QueryServiceConfigA" (ByVal hService As Long, _ lpServiceConfig As QUERY_SERVICE_CONFIG, _ ByVal cbBufSize As Long, pcbBytesNeeded As Long) As Long Private Declare Function QueryServiceStatus Lib "advapi32" _ (ByVal hService As Long, lpServiceStatus As SERVICE_STATUS) As Long Private Declare Function ControlService Lib "advapi32" _ (ByVal hService As Long, ByVal dwControl As SERVICE_CONTROL, _ lpServiceStatus As SERVICE_STATUS) As Long Private Declare Function StartService Lib "advapi32" _ Alias "StartServiceA" (ByVal hService As Long, _ ByVal dwNumServiceArgs As Long, ByVal lpServiceArgVectors As Long) As Long Private Declare Function NetWkstaUserGetInfo Lib "Netapi32" (ByVal reserved As Any, ByVal Level As Long, lpBuffer As Any) As Long Private Declare Function NetApiBufferFree Lib "Netapi32" (ByVal lpBuffer As Long) As Long Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long Private Const SERVICE_NAME As String = "FileDisk" Private Const Service_Display_Name As String = "FileDisk" Private Const Service_File_Name As String = "filedisk.sys" Public AppPath As String ' This function returns current service status ' or 0 on error Public Function GetServiceStatus() As SERVICE_STATE Dim hSCManager As Long, hService As Long, Status As SERVICE_STATUS hSCManager = OpenSCManager(vbNullString, vbNullString, _ SC_MANAGER_CONNECT) If hSCManager <> 0 Then hService = OpenService(hSCManager, SERVICE_NAME, SERVICE_QUERY_STATUS) If hService <> 0 Then If QueryServiceStatus(hService, Status) Then GetServiceStatus = Status.dwCurrentState End If CloseServiceHandle hService End If CloseServiceHandle hSCManager End If End Function ' This function fills Service Account field in form. ' It returns nonzero value on error Public Function GetServiceConfig() As Long Dim hSCManager As Long, hService As Long Dim r As Long, SCfg() As QUERY_SERVICE_CONFIG, r1 As Long, s As String hSCManager = OpenSCManager(vbNullString, vbNullString, _ SC_MANAGER_CONNECT) If hSCManager <> 0 Then hService = OpenService(hSCManager, SERVICE_NAME, SERVICE_QUERY_CONFIG) If hService <> 0 Then ReDim SCfg(1 To 1) If QueryServiceConfig(hService, SCfg(1), 36, r) = 0 Then If Err.LastDllError = ERROR_INSUFFICIENT_BUFFER Then r1 = r \ 36 + 1 ReDim SCfg(1 To r1) If QueryServiceConfig(hService, SCfg(1), r1 * 36, r) <> 0 Then s = Space$(255) lstrcpy s, SCfg(1).lpServiceStartName s = left$(s, lstrlen(s)) Else GetServiceConfig = Err.LastDllError End If Else GetServiceConfig = Err.LastDllError End If End If CloseServiceHandle hService Else GetServiceConfig = Err.LastDllError End If CloseServiceHandle hSCManager Else GetServiceConfig = Err.LastDllError End If End Function ' This function installs service on local computer ' It returns nonzero value on error Public Function SetNTService() As Long Dim hSCManager As Long Dim hService As Long, DomainName As String hSCManager = OpenSCManager(vbNullString, vbNullString, _ SC_MANAGER_CREATE_SERVICE) If hSCManager <> 0 Then ' Install service to manual start. To set service to autostart ' replace SERVICE_DEMAND_START to SERVICE_AUTO_START hService = CreateService(hSCManager, SERVICE_NAME, _ Service_Display_Name, SERVICE_ALL_ACCESS, _ SERVICE_KERNEL_DRIVER, _ SERVICE_DEMAND_START, SERVICE_ERROR_NORMAL, _ App.Path & "\" & Service_File_Name, vbNullString, _ vbNullString, vbNullString, vbNullString, _ vbNullString) If hService <> 0 Then CloseServiceHandle hService Else SetNTService = Err.LastDllError End If CloseServiceHandle hSCManager Else SetNTService = Err.LastDllError End If End Function ' This function uninstalls service ' It returns nonzero value on error Public Function DeleteNTService() As Long Dim hSCManager As Long Dim hService As Long, Status As SERVICE_STATUS hSCManager = OpenSCManager(vbNullString, vbNullString, _ SC_MANAGER_CONNECT) If hSCManager <> 0 Then hService = OpenService(hSCManager, SERVICE_NAME, _ SERVICE_ALL_ACCESS) If hService <> 0 Then ' Stop service if it is running ControlService hService, SERVICE_CONTROL_STOP, Status If DeleteService(hService) = 0 Then DeleteNTService = Err.LastDllError End If CloseServiceHandle hService Else DeleteNTService = Err.LastDllError End If CloseServiceHandle hSCManager Else DeleteNTService = Err.LastDllError End If End Function ' This function returns local network domain name ' or zero-length string on error Public Function GetDomainName() As String Dim lpBuffer As Long, l As Long, p As Long If NetWkstaUserGetInfo(0&, 1&, lpBuffer) = 0 Then CopyMemory p, ByVal lpBuffer + 4, 4 l = lstrlenW(p) If l > 0 Then GetDomainName = Space$(l) CopyMemory ByVal StrPtr(GetDomainName), ByVal p, l * 2 End If NetApiBufferFree lpBuffer End If End Function ' This function starts service ' It returns nonzero value on error Public Function StartNTService() As Long Dim hSCManager As Long, hService As Long hSCManager = OpenSCManager(vbNullString, vbNullString, _ SC_MANAGER_CONNECT) If hSCManager <> 0 Then hService = OpenService(hSCManager, SERVICE_NAME, SERVICE_START) If hService <> 0 Then If StartService(hService, 0, 0) = 0 Then StartNTService = Err.LastDllError End If CloseServiceHandle hService Else StartNTService = Err.LastDllError End If CloseServiceHandle hSCManager Else StartNTService = Err.LastDllError End If End Function ' This function stops service ' It returns nonzero value on error Public Function StopNTService() As Long Dim hSCManager As Long, hService As Long, Status As SERVICE_STATUS hSCManager = OpenSCManager(vbNullString, vbNullString, _ SC_MANAGER_CONNECT) If hSCManager <> 0 Then hService = OpenService(hSCManager, SERVICE_NAME, SERVICE_STOP) If hService <> 0 Then If ControlService(hService, SERVICE_CONTROL_STOP, Status) = 0 Then StopNTService = Err.LastDllError End If CloseServiceHandle hService Else StopNTService = Err.LastDllError End If CloseServiceHandle hSCManager Else StopNTService = Err.LastDllError End If End Function ' change this to "Public Sub Main ()" if you don't need a form Public Sub DoService() RegSVC StartSVC 'add your code here StopSVC UnRegSVC End End Sub Private Sub CheckService() If GetServiceConfig() = 0 Then Installed = True ServState = GetServiceStatus() Select Case ServState Case SERVICE_RUNNING Case SERVICE_STOPPED Case Else End Select Else Installed = False End If End Sub Public Sub RegSVC() CheckService If Not Installed Then SetNTService End If CheckService 'MsgBox ("It's installed") End Sub Public Sub UnRegSVC() CheckService If Installed Then DeleteNTService End If 'MsgBox ("Now it's uninstalled") End Sub Public Sub StartSVC() CheckService If ServState = SERVICE_STOPPED Then StartNTService End If CheckService 'MsgBox ("Now it's Started") End Sub Public Sub StopSVC() CheckService If ServState = SERVICE_RUNNING Then StopNTService End If CheckService 'MsgBox ("Now it's Stopped") End Sub Here's the thread that explains why I needed this module http://www.ubcd4win.com/forum/index.php?showtopic=3271&st=15