Winpe Menu.vbs de microsoft (ajout fonction en local disque usb)

Bonjour,

url : http://blogs.technet.com/b/oemfrance...windows-7.aspx

Je n'arrive pas à modifier le script vbs pour avoir une option "LOCAL", appliquer/création une image wim depuis le media de bootPe (repertoire WIM).

Avez-vous une idée?

En vous remerciant d'avance!

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965

'****************************************************************************** 'THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF 'ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED 'TO THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A ' PARTICULAR PURPOSE.*/ '******************************************************************************   '****************************************************************************** ' This Script is a VB Script sample of a Wim images deployment tools for ' System Builders. It could be used booted from a WinPE DVD or an UFD. '******************************************************************************   '****************************************************************************** ' Author : Jérôme Dakono : Microsoft OEM ' French version by Laurent Rivière : Microsoft OEM ' Czech Version by Tomas Kanturek : Microsoft OEM ' Turkish version by Tayfun Karabayir : Microsoft OEM ' Italian version by Franco Gilberti and Marcello Marino : Microsoft OEM ' Spanish version by Walter Cabanillas : Microsoft OEM ' Polish version by Piotr Zawadzki : Microsoft OEM ' Slovak version by Milan Krajci : Microsoft OEM ' ' Windows 7 update by Antoine Journaux : Microsoft OEM '******************************************************************************   '****************************************************************************** ' Versioning ' 10/01/2008 Version 1.0 ' 24/02/2008 Version 1.01 Support of Windows Vista SP1 (WinPE 2.1) ' 02/04/2008 Version 1.1 Integration of the Fast Deployement Method ' April 2009 version 1.2 Default text are updated for Windows 7 ' Septembre 2009 Version 2.0 Windows 7 full support '******************************************************************************     Option Explicit   ' Global variables Dim PHYSDRIVNB,BOOTFROM, DRVSIZE(20),MINPARTSIZE,DRVSIZEMO(20) Dim DVDSIZE,TOOLSDIR,BOOTDIR, UFDLABEL,IMAGEDIR,DRVDIR Dim NTWDRVLETTER,CLABELNAME,DRVMAPPED Dim REBOOTOK   ' Variable used in the main program Dim choice Dim mess Dim s,i,j   'Main menu text strings definition Dim StrMainMenuTitle,StrFormatHardDrive,StrSystemProperties,StrDeployImages,StrDeployImagesAndReboot,StrImagexBackUp,StrStartWinPEConsole,StrRestartSystem,StrChooseOption Dim StrCancel,StrCancelWinPE,StrCancelTitle,StrRestoreBoot   'Welcome box text stings definition Dim StrWelcomeTitle,StrWelcome1,StrWelcome2,StrWelcome3,StrWelcome4,StrWelcome5 'WinPE Console box strings definition Dim StrExitWinPEConsole 'System properties box strings definition Dim StrBIOS,StrProcessor,StrMaxClockSpeed,StrCurClockSpeed,StrL2CacheSize,StrRevision,StrCDROM Dim StrManufacturer,StrSocket,StrRelDate,StrVersion,StrDisknb,StrNbPartitions Dim StrSize,StrGigaOctets,StrCaption,StrModel,StrPartitionLabel,StrTotSpace Dim StrFileSystem,StrFormattedPartition,StrName,StrDescription Dim StrSMBIOSVer,StrSMBIOSMajVer,StrSMBIOSMinVer, StrPartition Dim StrFixedDisks,StrDisk,StrNoFormattedPartition,StrHardDrvNotFound Dim StrSystemPropTitle,StrLetter,StrLabel Dim StrBootFromCDROM,StrBootFromUFD,StrBootFromTestEnv 'Partitions box strings definition Dim StrHowManyPartition,StrOneOrTwo,StrQuestionPartitionSize1,StrQuestionPartitionSize2,StrQuestGigaOctets Dim StrQuestPartitionName, StrQuestMaxChar, StrTranferToUfd,StrWarningPartition,StrWarningTitle Dim StrPartitionsNameTitle,StrPartitionsSizeTitle, StrHowManyPartitionsTitle,StrAllSpaceAlreadyUsed,StrQuestDriveName,StrDriveNameTitle,StrHardDrvTooSmall Dim StrHaveSystemPartition,StrHaveSystemPartitionTitle,StrSizeSystemPartition,StrDriveLetterUsed,StrTitleWichPartition 'UFD transfer Menu boxes strings Dim StrRemoveRemovMedia, StrConnectUFD, StrUFDNotFound,StrUFDNotEnoughSpace Dim StrWarningUfdPartition,StrWarningBootUFD 'Memory box strings Dim StrMemTitle,StrMemBank,StrMemSize,StrMemTotalSize,StrMemSpeed ' Network adpater strings Dim StrNetworkAdaptTitle,StrConnected,StrNetAddress,StrDHCPServer,StrNotConnected,StrNetAdaptNotFound ' Deployement box strings Dim StrDeplChoice, StrDeplAvailImages, StrDeplCPartitionToSmall,StrDeplCPartitionNotFound,strMultiPartition Dim StrDeplWimFileNotFound,StrDeplWarning,StrDeplFormatFault Dim StrNetDisk,StrNoNetDisk,strChooseDriveForImageDeploy 'Backup box strings Dim StrBckDriveNotFound,StrBckConnectDrive,StrBckDestDrvNotFound,StrBckChooseDestPart Dim StrBckAvailablePartitions,StrBckEnterWimFileName,StrBckEnterLabelName   'Boot loader box strings Dim StrBootLoaderWinDir,StrBootLoaderWinDirTitle,StrFolderDoesntExist,StrBootLoaderBootDir,StrBootLoaderBootDirTitle,StrDriveDoesntExist   ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Texts and Messages section, ' By default the script is in english ' Translation in an other language should be done with the menu-messages.txt files ' The menu-messages.txt file should have the same syntax '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''     ' Main Menu Strings StrMainMenuTitle="Example of Windows 7® deployment tool" StrFormatHardDrive="Format Hard Drive" StrSystemProperties="System Properties" StrDeployImages="Deploy a WIM image" StrDeployImagesAndReboot="Deploy a WIM image and Reboot the system" StrImagexBackUp="Make a WIM File from a disk partition" StrStartWinPEConsole="Start a WinPE console" StrRestartSystem="Restart the system" StrTranferToUfd="Transfer this tool to a UFD" StrChooseOption="Choose an option" StrRestoreBoot="Restore Boot Loader"   ' Main Menu Cancel menu strings StrCancel= "Are you sure you want to exit ?" StrCancelWinPE="Are you sure you want to exit and reboot the system" StrCancelTitle="Exit"   'Welcome box strings with Trademark symbol and Registration mark StrWelcomeTitle="Disclaimer" StrWelcome1="Microsoft makes the Rapid Deployment script available to facilitate the installation of the Microsoft software identified in " StrWelcome2="the script. The script is provided "& Chr(34) & "AS IS" & Chr(34) &" and neither Microsoft Corporation nor any of its " StrWelcome3="affiliates provides any warranty regarding the content, usability, accuracy or completeness of the script. Delivery of " StrWelcome4="the script by Microsoft does not grant any license or other rights to the Microsoft software. Those rights must be acquired " StrWelcome5="separately in a license agreement."   'WinPE Console box strings StrExitWinPEConsole="Type exit to close the console"   'System Properties box strings StrSystemPropTitle="System Properties"   ' BIOS section StrBIOS="BIOS" StrRelDate="Release Date : " StrSMBIOSVer="Version: " StrSMBIOSMajVer="SMBIOS Major Version : " StrSMBIOSMinVer="SMBIOS Minor Version : " StrVersion="Version : "   ' Processeur section StrProcessor="PROCESSOR" StrName="Name : " StrDescription="Descritption : " StrMaxClockSpeed="Max Clock Speed : " StrCurClockSpeed="Current Clock Speed : " StrL2CacheSize="L2 Cache Size : " StrRevision="Revision : " StrManufacturer="Manufacturer : " StrSocket="Socket Designation : "   ' Drives section StrCDROM="CDROM" StrDisknb="Drive # : " StrDisk="Drive : " StrNbPartitions="Partitions # " StrPartition="Partition(s) : " StrSize="Size : " StrGigaOctets="GB" StrCaption="Caption : " StrModel="Model : " StrPartitionLabel="Partition Label : " StrTotSpace="Total Space : " StrFileSystem="FS : " StrFormattedPartition="FORMATTED PARTITION(S) on FIXED DRIVE(S)" StrFixedDisks="FIXED DRIVE(S)" StrNoNetDisk="**** IMAGES SERVER not connected ****" StrNetDisk="IMAGES SERVER(S)" StrLetter="Letter : " StrLabel="Label : " StrNoFormattedPartition="NO FORMATTED PARTITION on FIXED DRIVE(S)"   ' Memory section StrMemTitle="MEMORY" StrMemBank="Bank : " StrMemSize="Size : " StrMemTotalSize="Total memory size : " StrMemSpeed="Speed : "   ' Network adpater section StrNetworkAdaptTitle="ETHERNET ADAPTER(S)" StrConnected="Connected" StrNetAddress="Address : " StrDHCPServer="DHCP : " StrNotConnected="Not Connected" StrNetAdaptNotFound="**** ETHERNET ADAPTER NOT FOUND ****"   'Partitions Menu box strings StrTitleWichPartition="Choose the partition you want" StrPartitionsNameTitle="Partition Name" StrPartitionsSizeTitle="Partition Size" StrHardDrvTooSmall="Hard Drive too small for a Windows 7 install" StrSizeSystemPartition="Choose the size (in MB) of the System partition (between 50 – 500)" StrHaveSystemPartition="Do you want to create a system partition?" StrHaveSystemPartitionTitle="System partition" StrHowManyPartitionsTitle="Number of Partitions" StrHowManyPartition="How many partitions do you want to create on the first disk : " StrOneOrTwo="( 1 to 10 ) ?" StrQuestionPartitionSize1="Choose the size (in GB) of the " StrQuestionPartitionSize2=" partiton (between " StrQuestGigaOctets=") ?" StrAllSpaceAlreadyUsed="You already have used all space available on the disk, cancel to restart or continue" StrQuestPartitionName="Name of partition # " StrQuestMaxChar="(Max 20 characters)" StrQuestDriveName="Choose the drive letter for the partition " StrDriveNameTitle="Drive letter" StrBootFromTestEnv="The Script is working in test mode or the System is boot from a WDS Server" StrBootFromCDROM="The System is boot from CDROM" StrBootFromUFD="The System is boot from UFD" StrWarningPartition="This operation will remove ALL data from hard drive(s). To exit : Choose Cancel in the next menu" StrWarningTitle="Warning !" StrDriveLetterUsed="Attention, following letters are already in use, choosing one of theses may be like choosing none"   'UFD transfer Menu boxes strings StrRemoveRemovMedia="Disconnect all removable drives from the system" StrConnectUFD="Connect a UFD to the system (minimum size : " StrUFDNotEnoughSpace="UFD found but not enough space available" StrUFDNotFound="UFD not found" StrWarningUfdPartition="This operation will remove ALL data from UFD. To exit : Do not connect UFD to the system in the next menu" StrWarningBootUFD="The System is boot from UFD, this function is not supported in this configuration"     'Image deployment box strings StrHardDrvNotFound="Fixed Hard Drive not found : The installation of Windows 7 is not possible" StrDeplWarning="This operation will remove ALL data from the partition you will choose. To exit : Choose the Cancel Option in the next menu" StrDeplChoice="Choose the image to deploy" StrDeplAvailImages="Available Images on the server(s)" StrDeplCPartitionToSmall="The partition is too short to apply the image" StrDeplCPartitionNotFound="The partition is not found" strMultiPartition="It seems that there is a system partition on your hard drive, do not forget to capture it and then to deploy it to be able to boot." StrDeplWimFileNotFound="WIM File not found" StrDeplFormatFault="Error Formating the partition" strChooseDriveForImageDeploy="Choose the partition where you want to deploy a Wim file"   'Backup box strings StrBckDriveNotFound="C:\ drive not found or not ready" StrBckConnectDrive="The size of the C:\ partition is : " StrBckDestDrvNotFound="Destination drive not found" StrBckChooseDestPart="Choose the destination server" StrBckAvailablePartitions="Available images Server(s)" StrBckEnterWimFileName="Enter the WIM File name" StrBckEnterLabelName="Enter the backup Label Name"   'Boot Loader box strings StrBootLoaderWinDir = "Please enter the path to the windows directory (ex: C:\Windows)" StrBootLoaderWinDirTitle = "Windows Directory" StrFolderDoesntExist = "This folder does not exist. " StrBootLoaderBootDir = "Please enter the drive letter of the boot drive, leave blank if the boot drive is the same that the Windows one (ex: S:)" StrBootLoaderBootDirTitle = "Boot drive" StrDriveDoesntExist = "This drive letter does not exist. "   ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' End of Texts and Messages section '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''       '''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Set up global variables ''''''''''''''''''''''''''''''''''''''''''''''''''''''''   ' Default Winpe Folder TOOLSDIR="" ' Default image folder BOOTDIR="" ' Default directory name containing Wim images IMAGEDIR="images" ' Default directory name containing drivers to load dynamically DRVDIR="drivers" ' Minimum size in MB for an UFD drive for the tranfer of the DVD to an USB key ' The Size is computed when the DVD partion will be scanned DVDSIZE=4700 ' Minimum partition size in GB for partitioning operation MINPARTSIZE=10 ' Lable used for the UFD UFDLABEL="MAGIC" ' Used to know if the system is boot from a DVD(1) or an UFD(2) (0) if the system doesn't run on WinPE BOOTFROM=0 ' First Drive letter for Network Drives NTWDRVLETTER=Asc("M") ' To know if network drive(s) are already mapped DRVMAPPED=False     '''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Start Program ''''''''''''''''''''''''''''''''''''''''''''''''''''''''   On Error Resume Next 'Determine from wich device WinPE is boot (CDROM or UFD) FindBootDevice()   LoadDrivers()   'Map Network drive MapNetworkDrives()   ' Get translated messages if the menu-messages.txt file is present GetTranslatedStrings()   'Display Disclaimer Message WelcomeMessage()   'Display the system properties box SystemProperties()     ' Build the display of the main menu mess = mess & "1 " & StrSystemProperties & vbCrLf mess = mess & "2 " & StrFormatHardDrive & vbCrLf mess = mess & "3 " & StrDeployImages & vbCrLf mess = mess & "4 " & StrDeployImagesAndReboot & vbCrLf mess = mess & "5 " & StrImagexBackUp & vbCrLf mess = mess & "6 " & StrRestoreBoot & vbCrLf mess = mess & "7 " & StrStartWinPEConsole & vbCrLf mess = mess & "8 " & StrTranferToUfd & vbCrLf mess = mess & "9 " & StrRestartSystem & vbCrLf mess = mess & vbCrLf & vbCrLf mess = mess & StrChooseOption & vbCrLf     'Loop until the user choose to exit the program Do ' Display the Menu choice=NumChoiceInputBox(mess,StrMainMenuTitle,"1",9)   Select Case choice Case 0 ' Cancel button is selected. ' Ask for a confrmation to avoid intenpestive reboots; If BOOTFROM = 0 Then If PopUpMenu(StrCancel,StrCancelTitle,vbYesNo,0) = vbYes Then Exit Do Else If PopUpMenu(StrCancelWinPE,StrCancelTitle,vbYesNo,0) = vbYes Then Exit Do End If Case 1 ' This command re-check also the mapping of network drive(s) in case of the operator ' does a physial connection to the network adapter of the boot of the machine ' MapNetworkDrives() ' Display system properties SystemProperties() Case 2 ' Partitions creation menu CreatePartitions() Case 3 ' Deploy Wim Images menu DeployImages() Case 4 ' Deploy Wim Images menu and Reboot the system ' REBOOTOK will be set to true only if the user doesnt' cancel the command during the deployment menu. REBOOTOK=False DeployImages() ' Reboot Only If the user doesn't cancel the command in the deployment menus If REBOOTOK Then Exit Do Case 5 ' C:\ partition backup menu BackupCPart() Case 6 ' Restore Boot loader RestoreBootLoader() Case 7 ' Start a console StartCommandPrompt() Case 8 ' Copy DVD content to an UFD TransferToUfd() Case 9 ' Program Exit Exit Do End Select   Loop     WScript.Quit '''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' End of Program ''''''''''''''''''''''''''''''''''''''''''''''''''''''''       '''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Welcome Message '''''''''''''''''''''''''''''''''''''''''''''''''''''''' Sub WelcomeMessage() Dim mess mess = mess & StrWelcome1 & vbCrLf mess = mess & StrWelcome2 & vbCrLf mess = mess & StrWelcome3 & vbCrLf mess = mess & StrWelcome4 & vbCrLf mess = mess & StrWelcome5 & vbCrLf MsgBox mess,,StrWelcomeTitle End Sub     '''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Launch of WinPE command Console '''''''''''''''''''''''''''''''''''''''''''''''''''''''' Sub StartCommandPrompt()   Dim WshShell,Command   ' Launch the cmd command Set WshShell = WScript.CreateObject("WScript.Shell")   ' If the system is boot from a DVD or an UFD the console runs from the WinPE "tools" directory ' for an easy access to imageX command Command="cmd" If BOOTFROM<>0 Then Command= "cmd /K CD X:\Tools"   WshShell.run Command   ' Display a message explianing how to exit from the console ' WScript.Echo StrExitWinPEConsole MsgBox StrExitWinPEConsole   End Sub     '''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' WIM images Deployement menu '''''''''''''''''''''''''''''''''''''''''''''''''''''''' Sub DeployImages()   Dim mess,strLine,ImageXCmd Dim WshShell, oExec, sysPart, DriveToDeploy(10)   ' Limit : Maximum of 20 Wim Files and 10 images maximum on each Wim file Dim ImageName(20,10),ImageSize(20,10),DestinationDriveLetter Dim WimFileImageNumber(20),WimFileSize(20),WimFileName(20),WimFileDir(20)   Dim WimFileNumb,ImageNumb Dim i,j,s,ii,jj,ss Dim fso,d,CPartitionFound Dim errResult Dim objWMIService,objVolume,colVolumes Dim strOutputFile, objFileSystem, objOutputFile Dim choice,value, ActivePartitionCmd Dim files, fld,f1, Regx   MsgBox StrDeplWarning, vbExclamation ,StrWarningTitle   Set fso = WScript.CreateObject("Scripting.FileSystemObject") WimFileNumb=0   mess = strChooseDriveForImageDeploy & vbCrLf sysPart = False j=1 'scanning drives to know where to deploy the wim file For i=Asc("C") To Asc("W") If fso.DriveExists(Chr(i)) Then Set d = fso.GetDrive(Chr(i)) If d.IsReady Then If d.DriveType=2 Then DriveToDeploy(j)=Chr(i) mess = mess & j & " - " & StrLetter & d.DriveLetter& vbTab & StrLabel & d.VolumeName & vbTab mess = mess & CLng(d.Totalsize/1024/1024/1024) & "/" & CLng((d.Totalsize-d.AvailableSpace)/1024/1024/1024) & " GB" & vbCrLf If CLng(d.Totalsize/1024/1024) <= 512 then sysPart = True End If j = j+1 End If End If End If Next     ' MsbBox to alert that there is a system partition if sysPart then MsgBox StrMultiPartition end if   ' asking which partition must be captured choice=NumChoiceInputBox(mess,StrTitleWichPartition,"1",j-1) mess=""   DestinationDriveLetter = DriveToDeploy(choice)   'Scanning Wim files on all root directory of logical drives (From D to W) 'and in the \images of each root directories For i=Asc("C") To Asc("W")   'Check if the logical disk does exist If fso.DriveExists (Chr(i)) Then Set d = fso.GetDrive (Chr(i)) ' Limit to Network drive If d.IsReady and d.DriveType=3 Then If d.IsReady Then 'Check the root directory Set fld = fso.GetFolder (Chr(i) & ":\") Set files = fld.Files For Each f1 In files If Len (f1.Name)>=4 Then ss=LCase(f1.Name) If Right (ss,4)=".wim" Then WimFileNumb=WimFileNumb+1 WimFileName(WimFileNumb)=ss WimFileDir(WimFileNumb)=Chr (i) &":\" 'Replacing Network drive letter by the network path If d.DriveType=3 Then WimFileDir(WimFileNumb)=GetNetworkDrivePath(WimFileDir(WimFileNumb)) End If End If End If Next   ' Check the \images directory If fso.FolderExists(Chr(i) & ":\" & IMAGEDIR) Then Set fld = fso.GetFolder (Chr(i) & ":\" & IMAGEDIR) Set files = fld.Files For Each f1 In files If Len (f1.Name)>=4 Then ss=LCase(f1.Name) If Right (ss,4)=".wim" Then WimFileNumb=WimFileNumb+1 WimFileName(WimFileNumb)=ss WimFileDir(WimFileNumb)=Chr (i) &":\" 'Replacing Network drive letter by the network path If d.DriveType=3 Then WimFileDir(WimFileNumb)=GetNetworkDrivePath(WimFileDir(WimFileNumb)) End If ' Adding "\images" to the network drive WimFileDir(WimFileNumb)= WimFileDir(WimFileNumb) & IMAGEDIR & "\" End If End If Next End If End If End If   Next   ' Scanning the Wim File to display the list of images available in the file ' An imageX/scan is launched and the commend output is canned to retrieve ' images information.   ImageNumb=0   Set WshShell = WScript.CreateObject("WScript.Shell")   For i=1 To WimFileNumb ' Run the imageX command ImageXCmd=TOOLSDIR & "imagex /info " & WimFileDir(i)& WimFileName(i) Set oExec = WshShell.Exec("cmd") oExec.StdIn.Writeline ImageXCmd oExec.StdIn.Writeline "exit" ' Analyze the output of the command WimFileImageNumber(i)=0 WimFileSize(i)=0 ' Read line after line until the Shell is closed Do Until oExec.StdOut.AtEndOfStream strLine = oExec.StdOut.ReadLine()   ' Extracting Image Name from <TOTALBYTES>2324434535<\\TOTALBYTES> type lines If XMLDataExtractor (value,strLine,"TOTALBYTES")Then ' The first TOTALBYTE line is the size of the Wim File If WimFileSize(i)=0 Then ' The size in Bytes is converted to Gigabytes WimFileSize(i) = ConvertGBSize (value) Else ' The other TOTALBYTE lines are the size of the images ' The size in Bytes is converted into Gigabytes WimFileImageNumber(i)=WimFileImageNumber(i)+1 ImageSize(i,WimFileImageNumber(i))=ConvertGBSize (value)   End If ImageNumb=ImageNumb+1 End If   ' Extracting Image Name from <NAME>ABCDEFG<\NAME> If XMLDataExtractor (value,strLine,"NAME") Then ImageName(i,WimFileImageNumber(i))=value End If     Loop Next     ' Displaying the list of available images (name + size) in the Win File in a choice menu ' No Wim File foound If WimFileNumb=0 Or ImageNumb=0 Then MsgBox StrDeplWimFileNotFound Exit Sub End If   ' Displaying the list of available images (name + size) in the Win File in a choice menu ImageNumb=0 For i=1 To WimFileNumb If WimFileImageNumber(i)>0 Then mess = mess & WimFileDir(i)&" " & WimFileName(i) & " (" & WimFileSize(i)& "GB)" & vbCrLf For j=1 To WimFileImageNumber(i) ImageNumb=ImageNumb+1 mess = mess & ImageNumb & vbTab & ImageName(i,j) & " (" & ImageSize(i,j) & "GB)" & vbCrLf Next mess = mess & vbCrLf End If Next   mess= mess & vbCrLf & StrDeplChoice   ' Images deloyement menu display choice=NumChoiceInputBox (mess, StrDeplAvailImages,"",ImageNumb) If choice=0 Then Exit Sub   ' Retrieve the image number choosen by the user ImageNumb=0 For i=1 To WimFileNumb For j=1 To WimFileImageNumber(i) ImageNumb=ImageNumb+1 If choice=ImageNumb Then ii=i jj=j End If Next Next   ' Retreive the C:\ partition information CPartitionFound=False Set fso = WScript.CreateObject("Scripting.FileSystemObject") If fso.DriveExists("C") Then Set d = fso.GetDrive("C") If d.IsReady Then If d.DriveType=2 Then CPartitionFound=True End If End If End If   ' If C partition is not found, try to check is the C drive has a incorrect letter allocated ' Comparing the Label name of each drive with the Label Name chosed by the user during ' format operations If CPartitionFound=False Then For i=Asc("D") To Asc("W") 'Check if the logical disk does exist If fso.DriveExists (Chr(i)) Then Set d = fso.GetDrive (Chr(i)) If d.IsReady Then If d.DriveType=2 And d.VolumeName=CLABELNAME Then CPartitionFound=True ' assigning the destination letter to this drive DestinationDriveLetter=Chr(i) Exit For End If End If End If Next End If   ' Check if the C:\ partition exits and if it is large enough to receive the image. If CPartitionFound=True Then ' Manage 2 Giga bytes of space in addition of the image size If (d.Totalsize/1024/1024/1024 < ImageSize(ii,jj) + 2) Then MsgBox StrDeplCPartitionToSmall,vbExclamation Exit Sub End If Else ' C:\ partition not found MsgBox StrDeplCPartitionNotFound,vbExclamation Exit Sub End If   ' Excute the Format of the C: partition maintaining the label name Set objWMIService = GetObject("winmgmts:\\.\root\cimv2") Set colVolumes = objWMIService.ExecQuery("Select * from Win32_Volume Where Name = '" & DestinationDriveLetter & ":\\'") For Each objVolume In colVolumes errResult = objVolume.Format("NTFS",True,4096,d.VolumeName,False) Next   If errResult<>0 Then MsgBox StrDeplFormatFault, vbExclamation Exit Sub End If   ' Mark the C:\ partition as Active strOutputFile = TOOLSDIR & "diskconf.cmd" Set objFileSystem = CreateObject("Scripting.FileSystemObject") Set objOutputFile = objFileSystem.CreateTextFile(strOutputFile, True) objOutputFile.WriteLine("Select Disk 0") objOutputFile.WriteLine("Select Partition 1") objOutputFile.WriteLine("Active") objOutputFile.WriteLine("Exit") objOutputFile.Close     ' Launch the Diskpart command on an Console Set WshShell = WScript.CreateObject("WScript.Shell") ActivePartitionCmd="DISKPART /S " & TOOLSDIR & "Diskconf.cmd" WshShell.Run ActivePartitionCmd,1,True   ' Apply the Image to the C:\partition ImageXCmd=TOOLSDIR & "imagex /apply " & WimFileDir(ii)&WimFileName(ii) & " " & jj & " " & DestinationDriveLetter &":\" ' Launch the image X command on an Console Set WshShell = WScript.CreateObject("WScript.Shell") WshShell.Run ImageXCmd,1,True   ' The Imagex command has been completed the system can reboot it the user has seleded this option. REBOOTOK=True   End Sub     '''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Restore boot loader '''''''''''''''''''''''''''''''''''''''''''''''''''''''' Sub RestoreBootLoader()   Dim WshShell, fso Dim BcdBootCmd, WindowsDir, BootDisk, choice Set fso = WScript.CreateObject("Scripting.FileSystemObject")   choice = InputBox (StrBootLoaderWinDir,StrBootLoaderWinDirTitle,"C:\Windows")   choice=Trim(choice) WindowsDir = "" if (not fso.FolderExists(choice)) Then Msgbox StrFolderDoesntExist & choice 'Exit Sub end if WindowsDir = choice   choice = InputBox (StrBootLoaderBootDir,StrBootLoaderBootDirTitle,"S:\") choice=Trim(choice) BootDisk = "" if (not (fso.DriveExists(choice) or Len(choice)=0)) Then Msgbox StrDriveDoesntExist & choice 'Exit Sub end if BootDisk = choice   Set WshShell = WScript.CreateObject("WScript.Shell") BcdBootCmd = "bcdboot " & WindowsDir & " /s " & BootDisk MsgBox BcdBootCmd WshShell.Run BcdBootCmd,1,True   End Sub   '''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Partition and Format menu ''''''''''''''''''''''''''''''''''''''''''''''''''''''''   Sub CreatePartitions() Dim objFileSystem, objOutputFile, strOutputFile,WshShell, oExec Dim FormatCmd,fso Dim partition(10), size(10), totalUsed, temp, letters(10) Dim i,j,nbpart,SizePart,str ,d Dim systemPart, StrWarningDriveLetter   ' If the system has one hard drive it is possible to create 2 partitions on the hard drive ' If the system has 2 hard drives 1 partition is created on each hard drive if the user ' choose to cretae 2 partitions. This srcipt can't take care of more of 2 hard drives   ' No Fixed drive the deployement of Windows is not possible ! If PHYSDRIVNB = 0 Then Messagebox StrHardDrvNotFound End If   if DRVSIZE(1) <= MINPARTSIZE then MsgBox StrHardDrvTooSmall exit sub end if   ' Warning message before formatting hard drives MsgBox StrWarningPartition,vbExclamation,StrWarningTitle   ' Do you want to create a system partition if MsgBox(StrHaveSystemPartition, vbYesNo, StrHaveSystemPartitionTitle) = vbYes Then systemPart = True totalUsed = 100 Else systemPart = False totalUsed = 0 End If     nbpart=0 'If PHYSDRIVNB=1 Then   ' Ask how many partition to create While (Not IsNumeric(nbpart) Or nbpart = 0 Or nbpart>10 Or str="") str = InputBox(StrHowManyPartition & " 1 " & StrOneOrTwo, StrHowManyPartitionsTitle, "1") If IsNumeric(str) Then nbpart = CInt(str) End If Wend if str="" then exit Sub end if 'End If     StrWarningDriveLetter = ""   Set fso = WScript.CreateObject("Scripting.FileSystemObject") For j=Asc("C") To Asc("X") 'Check if the logical disk does exist If fso.DriveExists (Chr(j)) Then Set d = fso.GetDrive(Chr(j)) 'If d.IsReady Then if d.DriveType <> 2 then StrWarningDriveLetter = StrWarningDriveLetter & Chr(j) & ", " end if 'End If End If Next     SizePart = 0 size(1) = 0 ' Asking for names and size of partitions For i=1 To nbpart   ' asking for size ' Reserving a minimum size for the second partition If (DRVSIZE(1) - totalUsed) = 0 Then MsgBox StrAllSpaceAlreadyUsed End if temp = 0   ' if this is not the last partition, we ask for the size of the partition, else all available space will be used. if i <> nbpart then 'while input is not numeric or input < MinPartSize or input >= available size and the available size > MinPartSize While ( (Not IsNumeric(str)) Or temp < MINPARTSIZE Or temp*1024 >= (DRVSIZEMO(1) - totalUsed) And (DRVSIZEMO(1) - totalUsed)> MINPARTSIZE*1024 ) str = InputBox(StrQuestionPartitionSize1 & i & StrQuestionPartitionSize2 & MINPARTSIZE & " - " & Int((DRVSIZEMO(1) - totalUsed)/1024) & StrQuestGigaOctets, StrPartitionsSizeTitle) If str = "" Then nbpart = 0 Exit Sub End If 'Checking the user has entered a valid value for the size   temp = CInt(str) On Error Resume Next If Err.Number <> 0 Then Err.Clear() End If   Wend     If i = 1 Then SizePart = temp End If size(i) = temp totalUsed = totalUsed + temp*1024 End If   ' asking for names ' Windows is the default name for the first partition str="" while str = "" If i=1 Then str = InputBox (StrQuestPartitionName & i & StrQuestMaxChar,StrPartitionsNameTitle,"Windows") Else str = InputBox (StrQuestPartitionName & i & StrQuestMaxChar,StrPartitionsNameTitle) End If str=Trim(str) wend ' Delete of blank characters   partition(i) = Left (str,20)     ' asking for drive letter str="" while str = "" If i=1 Then str = InputBox (StrQuestDriveName & i & vbCrLf & StrDriveLetterUsed & vbCrLf & StrWarningDriveLetter,StrDriveNameTitle,"C") Else str = InputBox (StrQuestDriveName & i & vbCrLf & StrDriveLetterUsed & vbCrLf & StrWarningDriveLetter,StrDriveNameTitle) End If   ' Delete of blank characters str=Trim(str)   Wend   letters(i) = Left (str,1)     Next   ' Storing globally the Label of the C partition. This information will be use if ' the C letter is not correctly allocated after a format operation CLABELNAME=partition(1)   ' generate a command file for Diskpart   strOutputFile = TOOLSDIR & "diskconf.cmd" Set objFileSystem = CreateObject("Scripting.FileSystemObject") Set objOutputFile = objFileSystem.CreateTextFile(strOutputFile, TRUE) objOutputFile.WriteLine("Select Disk 0") objOutputFile.WriteLine("Clean") ' One hard drive j=1 If PHYSDRIVNB=1 Then 'Create a system partition if wanted   If systemPart Then objOutputFile.WriteLine("Create Partition Primary Size=100") objOutputFile.WriteLine("Select Partition 1") objOutputFile.WriteLine("Format FS=NTFS QUICK") objOutputFile.WriteLine("Assign Letter S:") j=2 End If ' Create all the other partitions For i = 1 To nbpart   If nbpart = 1 or i = nbpart Then objOutputFile.WriteLine("Create Partition Primary") else objOutputFile.WriteLine("Create Partition Primary Size=" & (size(i) * 1024)) End If 'objOutputFile.WriteLine("Select Partition "&i) objOutputFile.WriteLine("Format FS=NTFS Label=" & Chr(34) & partition(i) & Chr(34) & " QUICK") 'objOutputFile.WriteLine("Select Partition "&i) If i = 1 Then objOutputFile.WriteLine("Active") End If 'objOutputFile.WriteLine("Assign") objOutputFile.WriteLine("Assign Letter " & letters(i) &":")   Next   End If   objOutputFile.WriteLine("Exit") objOutputFile.Close     ' Launch the Diskpart command on an Console Set WshShell = WScript.CreateObject("WScript.Shell") FormatCmd="DISKPART /S " & TOOLSDIR & "diskconf.cmd" WshShell.Run FormatCmd,1,True     End Sub     '''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Display the System Properties (BIOS, Procesosr, Memory,Hard drives ... '''''''''''''''''''''''''''''''''''''''''''''''''''''''' Sub SystemProperties()   Dim str Dim i   Dim objItem,colItems,objWMIService   ' Call Function to get CPU, Memory, Hard Drive info, partitions and CDROM   DisplayProcessorInfo str DisplayMemoryInfo str BiosProperties str DisplayFixedHrdDriveInfo str DisplayNetworkAdapterInfo str DisplayNetworkDrives str DisplayCDROMInfo str FormattedPartitionCount str   ' Finaly displaying the WinPE boot drive info (CDROM of UFD) and the ' Letter assigned to the drive. The value BOOTFROM is computed during ' the FindBootDevice Function. If BOOTFROM=0 Then str = str & vbCrLf & StrBootFromTestEnv If BOOTFROM=1 Then str = str & vbCrLf & StrBootFromCDROM & " : " & BOOTDIR If BOOTFROM=2 Then str = str & vbCrLf & StrBootFromUFD & " : " & BOOTDIR   ' Display of all properties MsgBox str,,StrSystemPropTitle   End Sub

---

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085

'''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'Get the number of formated partition and display partitions info '''''''''''''''''''''''''''''''''''''''''''''''''''''''' Sub FormattedPartitionCount(ByRef mess) Dim fso, d, i, nbpart   nbpart=0 Set fso = WScript.CreateObject("Scripting.FileSystemObject")   'Checking the number of partition scanning diks letter to C to W For i=Asc("C") To Asc("W") If fso.DriveExists(Chr(i)) Then Set d = fso.GetDrive(Chr(i)) If d.IsReady Then If d.DriveType=2 Then nbpart=nbpart+1 End If End If End If Next   'Display The numbers of partition If nbpart =0 Then mess = mess & vbCrLf & StrNoFormattedPartition & vbCrLf Else mess = mess & vbCrLf & StrFormattedPartition & vbCrLf End If   'Scan Hard Drives info from Letter C to Letter W (to avoid to see the WinPE default drive (X:)) ' and dsiplay info about partition For i=Asc("C") To Asc("W") If fso.DriveExists(Chr(i)) Then Set d = fso.GetDrive(Chr(i)) If d.IsReady Then If d.DriveType=2 Then mess = mess & StrLetter & d.DriveLetter& vbTab & StrLabel & d.VolumeName & vbTab mess = mess & StrFileSystem & d.FileSystem & vbTab mess = mess & CLng(d.Totalsize/1024/1024/1024) & "/" & CLng((d.Totalsize-d.AvailableSpace)/1024/1024/1024) & " GB" & vbCrLf End If End If End If Next   End Sub     'Search what is the boot device (CDROM or UFD) and what is the letter assigned to it to be able to find the Wim File to deploy 'The existance of the folder : EFI\MICROSOFT\BOOT\FONTS is done to recognize a drive containing WinPE 'This fucntion is called only ont time at the startup of the program '''''''''''''''''''''''''''''''''''''''''''''''''''''''' Sub FindBootDevice () '''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim fso, d,i Dim cdromfound   cdromfound=0 Set fso = WScript.CreateObject("Scripting.FileSystemObject") 'Scanning first if the OS is WinPE checking if the X drive does exist If Not fso.DriveExists("X") Then Exit Sub   'Scanning CDROMs and UDF For i=Asc("D") To Asc("W") If fso.DriveExists(Chr(i)) Then Set d = fso.GetDrive(Chr(i)) If d.IsReady Then   ' Checking CDROMs & DVDROMs If d.DriveType=4 Then If fso.FolderExists(d.DriveLetter& ":\EFI\MICROSOFT\BOOT\FONTS") Then BOOTDIR=d.DriveLetter & ":\" BOOTFROM=1 ' The machine is booted from WinPE then tools directory in on the X:\tools TOOLSDIR="X:\tools\" ' Computing the size of the data in MB on the DVD. ' In case of transfer to an UFD this size will be the ' minimum size requetstd of the UFD DVDSIZE=Round ((d.Totalsize-d.AvailableSpace)/1024/1024,0) ' Exit function, no need to scan UFDs . To avoid ' confusion when an UFD copied from the DVD is ' still connected to the machine Exit Sub End If End If   ' Checking UFD If d.DriveType=1 Then If fso.FolderExists(d.DriveLetter& ":\EFI\MICROSOFT\BOOT\FONTS") Then BOOTDIR=d.DriveLetter & ":\" BOOTFROM=2 ' The machine is booted from WinPE then tools directory in on the X:\tools TOOLSDIR="X:\tools\" End If End If   End If End If Next   'This is necessary to manage WDS Server scenarios If BOOTFROM=0 and fso.FolderExists("X:\tools") Then TOOLSDIR="X:\tools\" End If   End Sub     '''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'Getting CDROM information to be displayed on System properties '''''''''''''''''''''''''''''''''''''''''''''''''''''''' Sub DisplayCDROMInfo (ByRef mess)   Dim fso, d,i Dim cdromfound   Set fso = WScript.CreateObject("Scripting.FileSystemObject") cdromfound=0   For i= Asc("D") To Asc("W") If fso.DriveExists(Chr(i)) Then Set d = fso.GetDrive(Chr(i)) If d.IsReady Then ' Searching CDROM only If d.DriveType=4 Then If cdromfound=0 Then cdromfound=1 mess = mess & vbCrLf & StrCDROM & vbCrLf End If mess = mess & StrLetter & d.DriveLetter& vbTab & StrLabel & d.VolumeName & vbCrLf End If End If End If Next End Sub   '''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Check if a drive is a network drive and replace its name with the full link ''''''''''''''''''''''''''''''''''''''''''''''''''''''''   Function GetNetworkDrivePath (DriveLetter)   Dim Wshnet, MapDrives, i   Set Wshnet=WScript.CreateObject("WScript.Network") Set MapDrives=Wshnet.EnumNetworkDrives   ' No network drive found If MapDrives.Count = 0 Then GetNetworkDrivePath=DriveLetter Exit Function End If   For i=0 To MapDrives.Count - 1 Step 2 If MapDrives.Item(i)&"\" = DriveLetter Then GetNetworkDrivePath=MapDrives.Item(i+1)&"\" Exit Function End If Next   End Function       '''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'Display Network drives information '''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'This Function scans the network drives currently connected 'to the machine   Sub DisplayNetworkDrives (ByRef mess)   Dim Wshnet, MapDrives, i   Set Wshnet=WScript.CreateObject("WScript.Network") Set MapDrives=Wshnet.EnumNetworkDrives   ' No network drive found If MapDrives.Count = 0 Then mess = mess & vbCrLf & StrNoNetDisk & vbCrLf Exit Sub End If   DRVMAPPED=True   mess = mess & vbCrLf & StrNetDisk & vbCrLf For i=0 To MapDrives.Count - 1 Step 2 mess= mess & MapDrives.Item(i)& vbTab mess= mess & MapDrives.Item(i+1) & vbCrLf Next   End Sub     '''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'Map Network drives using info from networkdisk.txt '''''''''''''''''''''''''''''''''''''''''''''''''''''''' Sub MapNetworkDrives()   Dim fso,f,ReadTextFile Dim value Dim Path,Username,Password Dim Wshnet   ' Try to Map only if previus tentative was not successfull If DRVMAPPED Then Exit Sub   Set fso = CreateObject("Scripting.FileSystemObject")   ' Check if the networkdisk.txt does exist in : ' ' -first in the root directory of WinPE and secondely ' ' -secondly in the tools directory '   If Not fso.FileExists(BOOTDIR & "networkdisk.txt") And Not fso.FileExists(TOOLSDIR & "networkdisk.txt") Then mess = mess & Vbvrlf & StrNoNetDisk & vbCrLf Exit Sub End If   ' Read each line of the file ' The file should be in the folowing order ' <PATH>\\server\myimages </PATH> ' <USERNAME>MyUsername</USERNAME> ' <PASSWORD>MyPassword</PASSWORD> ' This sequence should be repeated For Each network drive ' The network mapping is done each time we find the "<PASSWORD>" line   ' Initilizing connection information Password="" Username="" Path=""   ' Opening the file in priority order If fso.FileExists(BOOTDIR & "networkdisk.txt") Then Set f = fso.OpenTextFile(BOOTDIR & "networkdisk.txt",1) Else Set f = fso.OpenTextFile(TOOLSDIR & "networkdisk.txt",1) End If   On Error Resume Next Do While f.AtEndOfStream <> True ReadTextFile=f.ReadLine ' Check and extract Parameters from the configuration file (XML like format) If XMLDataExtractor (value,ReadTextFile,"USERNAME") Then Username=value End If   If XMLDataExtractor (value,ReadTextFile,"PASSWORD") Then Password=value ' Excute the mapping of the network drive, errors are ignored Set Wshnet=WScript.CreateObject("WScript.Network") On Error Resume Next   ' Network drive mapping" Wshnet.MapNetworkDrive Chr(NTWDRVLETTER)& ":",Path,True,Username,Password If fso.FolderExists(Path) Then ' Mapping is Ok: change the letter for the next drive mapping NTWDRVLETTER=NTWDRVLETTER+1 End If   ' Reseting connections parameters (in case of several mappings need to be done) Password="" Username="" Path="" Set Wshnet = Nothing End If   If XMLDataExtractor (value,ReadTextFile,"PATH") Then Path=value End If   Loop On Error Goto 0 f.Close     End Sub     '''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'Load Drivers Network drives using info from networkdisk.txt '''''''''''''''''''''''''''''''''''''''''''''''''''''''' Sub LoadDrivers()   Dim WshShell,fso   Set WshShell = WScript.CreateObject("WScript.Shell") Set fso = CreateObject("Scripting.FileSystemObject")   If fso.FolderExists("X:\" & DRVDIR) Then WshShell.Run "drvload.exe " & "X:\" & DRVDIR,1,True   If fso.FolderExists(TOOLSDIR & DRVDIR) Then WshShell.Run "drvload.exe " & TOOLSDIR & DRVDIR,1,True   If fso.FolderExists(BOOTDIR & DRVDIR) Then WshShell.Run "drvload.exe " & BOOTDIR & DRVDIR,1,True   End Sub     '''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'Getting Network adpater status '''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'This Function checks if the network card is : ' present ' connected a physical network network ' have a TCP/IP address   Sub DisplayNetworkAdapterInfo (ByRef mess) Dim objWMIService, objItem, colItems Dim objWMIService2, objItem2, colItems2 Dim intAdapter Dim x   intAdapter = 0   ' WMI connection to Root CIM Set objWMIService = GetObject("winmgmts:\\.\root\cimv2") Set colItems = objWMIService.ExecQuery("Select * from Win32_NetworkAdapter")   For Each objItem In colItems   ' Take only Ethenert physical cards If objItem.AdapterType="Ethernet 802.3" And objItem.PhysicalAdapter Then intAdapter=intAdapter +1   ' If the card is connected to the network, check the TCP/IP status If objItem.NetConnectionStatus=2 Then Set colItems2 = objWMIService.ExecQuery("Select * from Win32_NetworkAdapterConfiguration") For Each objItem2 In colItems2 ' Retreiving the card comparing the MAC address If objItem.MACAddress=objItem2.MACAddress Then ' Extracting TCP/IP address If Not IsNull(objItem2.IPAddress) Then 'Ethernet Adapter section title for the first adapter listed If intAdapter=1 Then mess = mess & vbCrLf & StrNetworkAdaptTitle & vbCrLf ' Display of adapter TCP/IP address and the DHCP server address mess = mess & StrNetAddress & objItem2.IPAddress(0) & vbTab & vbTab & StrDHCPServer & objItem2.DHCPServer & vbCrLf End If End If Next Else 'Ethernet Adapter section title for the first adapter listed If intAdapter=1 Then mess = mess & vbCrLf & StrNetworkAdaptTitle & vbCrLf mess = mess & StrNotConnected & vbCrLf End If End If   Next   ' Alert message if network adpater is not found If intAdapter = 0 Then mess = mess & vbCrLf & StrNetAdaptNotFound & vbCrLf   End Sub   '''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'Getting Physical drives information '''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'This Function scans the fixed disks available In the machine 'and detect if the system don't have any fixed hard drive   Sub DisplayFixedHrdDriveInfo (ByRef mess) Dim objWMIService, objItem, colItems, strComputer, intDrive     intDrive = 0 PHYSDRIVNB=0   ' WMI connection to Root CIM Set objWMIService = GetObject("winmgmts:\\.\root\cimv2") Set colItems = objWMIService.ExecQuery("Select * from Win32_DiskDrive")   'Disk section title mess = mess & StrFixedDisks & vbCrLf   For Each objItem In colItems intDrive = intDrive + 1 If objItem.MediaType="Fixed hard disk media" Then PHYSDRIVNB=PHYSDRIVNB +1 mess = mess & StrDisknb & PHYSDRIVNB & vbTab &vbTab & vbTab mess = mess & StrCaption & objItem.Caption & vbCrLf mess = mess & StrPartition & objItem.Partitions & vbTab & vbTab mess = mess & StrModel & objItem.Model & vbCrLf ' Convert the drive size to Gigabytes DRVSIZE(intDrive)=Int (objItem.Size/1024/1024/1024) DRVSIZEMO(intDrive)=Int (objItem.Size/1024/1024) mess = mess & StrSize & CLng (objItem.Size/1024/1024/1024) & " GB" & vbCrLf End If Next   'No Fixed Hard drive availabe : Windows installation is not possible" If PHYSDRIVNB=0 Then mess = mess & StrHardDrvNotFound & vbCrLf End If   End Sub     '''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'Getting Memory information '''''''''''''''''''''''''''''''''''''''''''''''''''''''' Sub DisplayMemoryInfo (ByRef mess)   Dim TotalMem, objWMIService, BankNumber   TotalMem=0 BankNumber=1 mess= mess & StrMemTitle & vbCrLf For Each objWMIService In GetObject("winmgmts:{impersonationLevel=impersonate}\\.\root\cimv2").InstancesOf("Win32_PhysicalMemory") BankNumber = BankNumber +1 If Len (objWMIService.BankLabel) = 0 Then mess = mess & StrMemBank & BankNumber & " " Else mess = mess & StrMemBank & objWMIService.BankLabel & " " End If mess = mess & StrMemSize & objWMIService.Capacity/1024/1024 & " MB" & " " mess = mess & StrMemSpeed & objWMIService.Speed & " Mhz" mess = mess & vbCrLf TotalMem=TotalMem+objWMIService.Capacity/1024/1024 Next   mess = mess & StrMemTotalSize & TotalMem & " MB" & vbCrLf mess = mess & vbCrLf   End Sub     '''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'Getting BIOS information '''''''''''''''''''''''''''''''''''''''''''''''''''''''' Sub BiosProperties(ByRef mess)   Dim strComputer Dim objWMIService Dim ColBIOS,objBIOS   Set objWMIService = GetObject("winmgmts:\\.\root\cimv2") Set ColBIOS = objWMIService.ExecQuery("Select * from Win32_BIOS")   'BIOS section title and the BIOS date mess = mess & StrBIOS & vbTab & "(" & Now() & ")" & vbCrLf   For Each objBIOS In ColBIOS mess = mess & StrManufacturer & objBIOS.Manufacturer & vbCrLf mess = mess & StrRelDate & Left(objBIOS.ReleaseDate,8) & vbCrLf mess = mess & StrVersion & objBIOS.Version & vbCrLf mess = mess & vbCrLf Next   End Sub     '''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'Getting Processor information '''''''''''''''''''''''''''''''''''''''''''''''''''''''' Sub DisplayProcessorInfo (ByRef mess)   Dim objWMIService, colItems Dim objItem   'Processor section title mess = mess & StrProcessor & vbCrLf   Set objWMIService = GetObject("winmgmts:\\.\root\cimv2") Set colItems = objWMIService.ExecQuery("Select * from Win32_Processor")   For Each objItem In colItems mess = mess & StrName & objItem.Name & vbCrLf mess = mess & StrDescription & objItem.Description & vbCrLf mess = mess & StrMaxClockSpeed & objItem.MaxClockSpeed & vbTab & vbTab mess = mess & StrCurClockSpeed & objItem.CurrentClockSpeed & vbCrLf mess = mess & StrL2CacheSize & objItem.L2CacheSize & vbTab & vbTab & vbTab mess = mess & StrManufacturer & objItem.Manufacturer & vbCrLf mess = mess & StrRevision & objItem.Revision & vbTab & vbTab & vbTab mess = mess & StrSocket & objItem.SocketDesignation & vbCrLf mess = mess & vbCrLf Next   End Sub     '''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Tranfer from of the tool from DVD to an UFD '''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'The function do a first drive scan without any removable connected ' and do a second scan with the UFD drive connected     Sub TransferToUfd() Dim NbOfDisk1,NbOfDisk2,UfdPartition Dim FormatCmd,CopyCmd Dim UfdFound     Dim objWMIService, objItem, colItems, strComputer Dim fso,i,d Dim objFileSystem, objOutputFile Dim strOutputFile Dim WshShell, oExec     ' The function is not supported if the system is boot from an UFD If BOOTFROM=2 Then MsgBox StrWarningBootUFD,vbExclamation,StrWarningTitle Exit Sub End If   ' The user should first dicconnect All removable Media MsgBox StrRemoveRemovMedia   ' WMI connection to Root CIM Set objWMIService = GetObject("winmgmts:\\.\root\cimv2") Set colItems = objWMIService.ExecQuery("Select * from Win32_DiskDrive")   'First scan of the system drives NbOfDisk1=0 For Each objItem In colItems NbOfDisk1 = NbOfDisk1 + 1 Next     ' Warning message before formatting UFD MsgBox StrWarningUfdPartition,vbExclamation,StrWarningTitle   ' The user should connect the UFD MsgBox StrConnectUFD & DVDSIZE & " MB)"     'Second scan of the system drives with a check of the minimum size of the UFD NbOfDisk2=0 Set objWMIService = GetObject("winmgmts:\\.\root\cimv2") Set colItems = objWMIService.ExecQuery("Select * from Win32_DiskDrive") UfdFound=0 NbOfDisk2=0 For Each objItem In colItems NbOfDisk2 = NbOfDisk2 + 1 'Search removable drive If objItem.MediaType="Removable Media" Then If Int (objItem.Size/1024/1024) > DVDSIZE Then UfdFound=1 Else MsgBox StrUFDNotEnoughSpace Exit Sub End If End If Next   'Display warning message if UFD is not found If NbOfDisk1+1<>NbOfDisk2 Then MsgBox StrUFDNotFound Else ' Build the Diskpart command file strOutputFile = TOOLSDIR & "diskconf.cmd" Set objFileSystem = CreateObject("Scripting.FileSystemObject") Set objOutputFile = objFileSystem.CreateTextFile(strOutputFile, True) objOutputFile.WriteLine("Select Disk "& NbOfDisk1) objOutputFile.WriteLine("Clean") objOutputFile.WriteLine("Create Partition Primary") objOutputFile.WriteLine("Select Partition 1") objOutputFile.WriteLine("Active") objOutputFile.WriteLine("Format FS=FAT32 Label=" & Chr(34) & UFDLABEL & Chr(34) & " QUICK") objOutputFile.WriteLine("Assign") objOutputFile.WriteLine("Exit") objOutputFile.Close     ' Launch the Diskpart command Set WshShell = WScript.CreateObject("WScript.Shell") FormatCmd="DISKPART /S " & TOOLSDIR & "Diskconf.cmd" WshShell.Run FormatCmd,1,True   'Getting Partitions infortmation Set fso = WScript.CreateObject("Scripting.FileSystemObject") For i=Asc("C") To Asc("W") If fso.DriveExists(Chr(i)) Then Set d = fso.GetDrive(Chr(i)) If d.IsReady Then If d.VolumeName=UFDLABEL Then UfdPartition=d.DriveLetter End If End If End If Next   ' Launch the Copy of the DVD to the UDF CopyCmd="xcopy " & BOOTDIR & "*.* /s /e /f " & UfdPartition & ":\" WshShell.Run CopyCmd,1,True   End If   End Sub   '''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' This function Make a simple backup of the C:\ partition ' to the root of a avalabe logical disk (could be a network drive) ' disk using Imagex. If the backup file already exist then ' the backup is done using "append" mode. '''''''''''''''''''''''''''''''''''''''''''''''''''''''' Sub BackupCPart()   Dim fso,WshShell,mess, nbpart Dim CPartitionSize Dim i,d,NbOfPartitionAvailable,ImageXCmd,j Dim DriveSize(10),DriveLetter(10),DriveLabel(10), DriveToCapture(10) Dim Label,WimFileName, sysPart,diskToCapture   mess = ""   ' WMI connection to Root CIM Set fso = WScript.CreateObject("Scripting.FileSystemObject")   'Checking the number of partition scanning diks letter to C to W For i=Asc("C") To Asc("W") If fso.DriveExists(Chr(i)) Then Set d = fso.GetDrive(Chr(i)) If d.IsReady Then If d.DriveType=2 Then nbpart=nbpart+1 End If End If End If Next j=1 sysPart = False 'Display The numbers of partition If nbpart =0 Then mess = mess & vbCrLf & StrNoFormattedPartition & vbCrLf Else mess = mess & vbCrLf & StrFormattedPartition & vbCrLf End If 'Scan Hard Drives info from Letter C to Letter W (to avoid to see the WinPE default drive (X:)) ' and dsiplay info about partition   For i=Asc("C") To Asc("W") If fso.DriveExists(Chr(i)) Then Set d = fso.GetDrive(Chr(i)) If d.IsReady Then If d.DriveType=2 Then DriveToCapture(j)=Chr(i) mess = mess & j & " - " & StrLetter & d.DriveLetter& vbTab & StrLabel & d.VolumeName & vbTab mess = mess & CLng(d.Totalsize/1024/1024/1024) & "/" & CLng((d.Totalsize-d.AvailableSpace)/1024/1024/1024) & " GB" & vbCrLf If CLng(d.Totalsize/1024/1024) <= 512 then sysPart = True End If j = j+1 End If End If End If Next     ' MsbBox to alert that there is a system partition if sysPart then MsgBox StrMultiPartition end if   ' asking which partition must be captured choice=NumChoiceInputBox(mess,StrTitleWichPartition,"1",j-1) diskToCapture = choice   set d = fso.GetDrive(DriveToCapture(choice))   If d.IsReady Then If d.DriveType=2 Then ' Get the size of the partition to backup   CPartitionSize=Round ((d.Totalsize-d.AvailableSpace)/1024/1024/1024,2) End If End If   ' Asking to the user to connect a drive and specifying the size of the partition MsgBox StrBckConnectDrive &" "& CPartitionSize & " GB"   NbOfPartitionAvailable=0   'The size of the available partition is not checked due to the imageX compression rate 'that is difficult to predict depending of the data on the C:\ partition.   'From D to W For i=Asc("D") To Asc("W") If fso.DriveExists(Chr(i)) Then Set d = fso.GetDrive(Chr(i)) ' Limit to Network drive If d.IsReady and d.DriveType=3 Then If d.IsReady Then ' Removable Media, Fixed drives and network drives are Ok ' If d.DriveType=1 Or d.DriveType=2 Or d.DriveType=3 Or d.DriveType=4 Then If d.AvailableSpace >0 Then NbOfPartitionAvailable=NbOfPartitionAvailable + 1 DriveLetter(NbOfPartitionAvailable)= Chr(i) & ":\" 'Replacing Network drive letter by the network path If d.DriveType=3 Then DriveLetter(NbOfPartitionAvailable)=GetNetworkDrivePath(DriveLetter(NbOfPartitionAvailable)) End If DriveSize(NbOfPartitionAvailable)=Round (d.AvailableSpace/1024/1024/1024,2) DriveLabel(NbOfPartitionAvailable)=d.VolumeName End If 'End If End If End If Next   mess = "" 'Back to the main menu if no partition are found If NbOfPartitionAvailable=0 Then MsgBox StrBckDestDrvNotFound Exit Sub End If   For i = 1 To NbOfPartitionAvailable mess = mess & i & vbTab & DriveLetter(i)& vbTab & DriveLabel(i)& vbTab & "(" &DriveSize(i) & " GB)" & vbCrLf Next mess = mess & vbCrLf & StrBckChooseDestPart   ' Display the choice menu with all images available choice=NumChoiceInputBox(mess,StrBckAvailablePartitions,"1",NbOfPartitionAvailable) If choice=0 Then Exit Sub   ' Get the Wim File name WimFileName=InputBox(StrBckEnterWimFileName,"","SevenImage.wim") ' Delete of blank characters WimFileName=Trim(WimFileName) If Len (WimFileName)=0 Then Exit Sub End If   'Conversion to lowercase WimFileName=LCase(WimFileName)   ' Check if the wim extension has been entererd by the user, ' if not the .wim extension is added to the filename If Len(WimFileName)>=4 Then If Right(WimFileName,4)<>".wim" Then WimFileName=WimFileName & ".wim" End If   ' Get the Label name of the backup Label=InputBox(StrBckEnterLabelName) ' Delete of blank characters Label=Trim(Label) If Len (Label)=0 Then Exit Sub End If ' 25 Charaters maximum for the image label name, other charcaters are truncated If Len (Label)>25 Then Label=Left(Label,25) End If   ' If the \images directory exists the wimfile is created in it instead ' of the drive root directory If fso.FolderExists(DriveLetter(choice) & IMAGEDIR) Then WimFileName=IMAGEDIR &"\"& WimFileName       ' Creation of the ImageX Command If fso.FileExists(DriveLetter(choice) & WimFileName) Then ImageXCmd=TOOLSDIR & "imagex /append " & DriveToCapture(diskToCapture) & ":\ " & DriveLetter(choice) & WimFileName & " " & Chr(34) & Label & Chr(34) Else ImageXCmd=TOOLSDIR & "imagex /capture " & DriveToCapture(diskToCapture) & ":\ " & DriveLetter(choice) & WimFileName & " " & Chr(34) & Label & Chr(34) End If       'Start the Imagex Command Set WshShell = WScript.CreateObject("WScript.Shell") WshShell.Run ImageXCmd,1,True   End Sub       '''''''''''''''''''''''''''''''''''''''''''''''''' ' This function extracts Data from an XML style line ''''''''''''''''''''''''''''''''''''''''''''''''''   Function XMLDataExtractor(ByRef value,line, tag ) Dim ltag   value=line 'Removing blanck characters from the input line value=Trim(value) ltag=Len(tag)+2   ' basic checks XMLDataExtractor=0 If value="" Then Exit Function If ltag=2 Then Exit Function If Len(value) <= (ltag * 2) + 1 Then Exit Function   ' eliminating control character at the end of the line If Right(value,1) < Chr(20) Then value = Left (value,(Len (value) -1)) End If   ' Checking the tag is present" If Left(value,ltag) = "<" & tag & ">" And Right(value,(ltag+1)) = "</" & tag & ">" Then ' XMLDataExtractor=1 ' Get the value value =Right(value,Len(value) - ltag) value =Left(value,Len (value) - ltag-1) End If   End Function         '''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' This function converts a very long integer (Image size in Bytes) ' into a 2 decimal number representing the size in Giga Bytes '''''''''''''''''''''''''''''''''''''''''''''''''''''''' Function ConvertGBSize (ByRef GbSize) Dim Size1,Size2 Size1=0 Size2=0   'Converting the Left part of the String Size1=CLng(Right(GBSize,9)) /1024/1024/1024   'Converting the right part of the string If Len(GbSize) > 9 Then Size2= CLng(Left(GBSize,(Len(GbSize)-9)))/1.024/1.024/1.024 End If   'Returning the total value with 2 decimal ConvertGBSize=Round(Size1 + Size2,2)   End Function   Function NumChoiceInputBox(mess,Title,mode,nbchoice) Dim choice Dim s Do ' Display the Menu s=InputBox (mess,Title,mode) If s="" Then NumChoiceInputBox=0 Exit Function End If   On Error Resume Next choice=CInt(s) If Err.Number<>0 Then Err.Clear choice=-1 End If   If choice>=1 And choice<=nbchoice Then NumChoiceInputBox=choice Exit Function End If   Loop   End Function   Function PopUpMenu(mess,title,mode,timeout) Dim Answer Dim oShell Set oShell = WScript.CreateObject("WScript.Shell") PopUpMenu = oShell.Popup (mess,timeout,title,mode) End Function     '''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Get tranlated messages from menu-messages.txt file '''''''''''''''''''''''''''''''''''''''''''''''''''''''' Sub GetTranslatedStrings()   Dim fso,f,ReadTextFile Dim value Dim Path,Username,Password Dim Wshnet Dim UnicodeFile Dim ReadChar,LowByte,HiByte     Set fso = CreateObject("Scripting.FileSystemObject") ' Check if the message file : menu-messages.txt does exist in the tools directory If Not fso.FileExists(TOOLSDIR & "menu-messages.txt") Then Exit Sub End If       ' Check if the file is Unicode or not checking the 2 first bytes in the file. UnicodeFile=False Set f = fso.OpenTextFile(TOOLSDIR & "menu-messages.txt",1) LowByte=f.Read(1) HiByte=f.Read(1) If Asc(LowByte)=255 And Asc(HiByte)=254 Then UnicodeFile=True f.Close   ' Read each line containing a translated message has ' VB Script like syntax : MyString="Format Hard Drive" ' File message is could be either simple txt file of Unicode Txt file ' for languages like Chinese, Russian, Czech.   Set f = fso.OpenTextFile(TOOLSDIR & "menu-messages.txt",1) On Error Resume Next   ' Reading the 2 first charactres of the unicode file ' to set the pointer to the beginning of text messagaes' If UnicodeFile = True Then f.read(2)   Do While f.AtEndOfStream <> True ' Read of an Unicode file line If UnicodeFile = True Then ReadTextFile="" Do While f.AtEndOfStream <> True LowByte=f.Read(1) HiByte=f.Read(1) If LowByte=vbCr And HiByte= Chr(0) Then ' Read the Line Feed Character (2 bytes in Unicode) and exit the loop f.Read(1) f.Read(1) Exit Do End If ReadChar=(Asc(HiByte)*256) + Asc(LowByte) ReadTextFile=ReadTextFile & chrW(ReadChar) Loop Else ' Read of a regular text file line ReadTextFile=f.ReadLine End If   ' Main Menu Strings If CheckParameter("StrMainMenuTitle",ReadTextFile) Then StrMainMenuTitle=GetString(ReadTextFile) If CheckParameter("StrFormatHardDrive",ReadTextFile) Then StrFormatHardDrive=GetString(ReadTextFile) If CheckParameter("StrSystemProperties",ReadTextFile) Then StrSystemProperties=GetString(ReadTextFile) If CheckParameter("StrDeployImages",ReadTextFile) Then StrDeployImages=GetString(ReadTextFile) If CheckParameter("StrDeployImagesAndReboot",ReadTextFile) Then StrDeployImagesAndReboot=GetString(ReadTextFile) If CheckParameter("StrImagexBackUp",ReadTextFile) Then StrImagexBackUp=GetString(ReadTextFile) If CheckParameter("StrStartWinPEConsole",ReadTextFile) Then StrStartWinPEConsole=GetString(ReadTextFile) If CheckParameter("StrRestartSystem",ReadTextFile) Then StrRestartSystem=GetString(ReadTextFile) If CheckParameter("StrTranferToUfd",ReadTextFile) Then StrTranferToUfd=GetString(ReadTextFile) If CheckParameter("StrChooseOption",ReadTextFile) Then StrChooseOption=GetString(ReadTextFile) If CheckParameter("StrRestoreBoot",ReadTextFile) Then StrRestoreBoot=GetString(ReadTextFile)   ' Main Menu Cancel menu strings If CheckParameter("StrCancel",ReadTextFile) Then StrCancel=GetString(ReadTextFile) If CheckParameter("StrCancelWinPE",ReadTextFile) Then StrCancelWinPE=GetString(ReadTextFile) If CheckParameter("StrCancelTitle",ReadTextFile) Then StrCancelTitle=GetString(ReadTextFile)   'Welcome box strings with Trademark symbol and Registration mark If CheckParameter("StrWelcomeTitle",ReadTextFile) Then StrWelcomeTitle=GetString(ReadTextFile) If CheckParameter("StrWelcome1",ReadTextFile) Then StrWelcome1=GetString(ReadTextFile) If CheckParameter("StrWelcome2",ReadTextFile) Then StrWelcome2=GetString(ReadTextFile) If CheckParameter("StrWelcome3",ReadTextFile) Then StrWelcome3=GetString(ReadTextFile) If CheckParameter("StrWelcome4",ReadTextFile) Then StrWelcome4=GetString(ReadTextFile) If CheckParameter("StrWelcome5",ReadTextFile) Then StrWelcome5=GetString(ReadTextFile)   'WinPE Console box strings If CheckParameter("StrExitWinPEConsole",ReadTextFile) Then StrExitWinPEConsole=GetString(ReadTextFile)   'System Properties box strings If CheckParameter("StrSystemPropTitle",ReadTextFile) Then StrSystemPropTitle=GetString(ReadTextFile) If CheckParameter("StrBIOS",ReadTextFile) Then StrBIOS=GetString(ReadTextFile) If CheckParameter("StrCDROM",ReadTextFile) Then StrCDROM=GetString(ReadTextFile) If CheckParameter("StrProcessor",ReadTextFile) Then StrProcessor=GetString(ReadTextFile) If CheckParameter("StrName",ReadTextFile) Then StrName=GetString(ReadTextFile) If CheckParameter("StrDescription",ReadTextFile) Then StrDescription=GetString(ReadTextFile) If CheckParameter("StrMaxClockSpeed",ReadTextFile) Then StrMaxClockSpeed=GetString(ReadTextFile) If CheckParameter("StrCurClockSpeed",ReadTextFile) Then StrCurClockSpeed=GetString(ReadTextFile) If CheckParameter("StrL2CacheSize",ReadTextFile) Then StrL2CacheSize=GetString(ReadTextFile) If CheckParameter("StrRevision",ReadTextFile) Then StrRevision=GetString(ReadTextFile) If CheckParameter("StrManufacturer",ReadTextFile) Then StrManufacturer=GetString(ReadTextFile) If CheckParameter("StrSocket",ReadTextFile) Then StrSocket=GetString(ReadTextFile) If CheckParameter("StrRelDate",ReadTextFile) Then StrRelDate=GetString(ReadTextFile) If CheckParameter("StrSMBIOSVer",ReadTextFile) Then StrSMBIOSVer=GetString(ReadTextFile) If CheckParameter("StrSMBIOSMajVer",ReadTextFile) Then StrSMBIOSMajVer=GetString(ReadTextFile) If CheckParameter("StrSMBIOSMinVer",ReadTextFile) Then StrSMBIOSMinVer=GetString(ReadTextFile) If CheckParameter("StrVersion",ReadTextFile) Then StrVersion=GetString(ReadTextFile) If CheckParameter("StrDisknb",ReadTextFile) Then StrDisknb=GetString(ReadTextFile) If CheckParameter("StrDisk",ReadTextFile) Then StrDisk=GetString(ReadTextFile) If CheckParameter("StrNbPartitions",ReadTextFile) Then StrNbPartitions=GetString(ReadTextFile) If CheckParameter("StrPartition",ReadTextFile) Then StrPartition=GetString(ReadTextFile) If CheckParameter("StrSize",ReadTextFile) Then StrSize=GetString(ReadTextFile) If CheckParameter("StrGigaOctets",ReadTextFile) Then StrGigaOctets=GetString(ReadTextFile) If CheckParameter("StrCaption",ReadTextFile) Then StrCaption=GetString(ReadTextFile) If CheckParameter("StrModel",ReadTextFile) Then StrModel=GetString(ReadTextFile) If CheckParameter("StrPartitionLabel",ReadTextFile) Then StrPartitionLabel=GetString(ReadTextFile) If CheckParameter("StrTotSpace",ReadTextFile) Then StrTotSpace=GetString(ReadTextFile) If CheckParameter("StrFileSystem",ReadTextFile) Then StrFileSystem=GetString(ReadTextFile) If CheckParameter("StrFormattedPartition",ReadTextFile) Then StrFormattedPartition=GetString(ReadTextFile) If CheckParameter("StrFixedDisks",ReadTextFile) Then StrFixedDisks=GetString(ReadTextFile) If CheckParameter("StrNoNetDisk",ReadTextFile) Then StrNoNetDisk=GetString(ReadTextFile) If CheckParameter("StrNetDisk",ReadTextFile) Then StrNetDisk=GetString(ReadTextFile) If CheckParameter("StrLetter",ReadTextFile) Then StrLetter=GetString(ReadTextFile) If CheckParameter("StrLabel",ReadTextFile) Then StrLabel=GetString(ReadTextFile) If CheckParameter("StrNoFormattedPartition",ReadTextFile) Then StrNoFormattedPartition=GetString(ReadTextFile) If CheckParameter("StrHardDrvNotFound",ReadTextFile) Then StrHardDrvNotFound=GetString(ReadTextFile)   ' Memory If CheckParameter("StrMemTitle",ReadTextFile) Then StrMemTitle=GetString(ReadTextFile) If CheckParameter("StrMemBank",ReadTextFile) Then StrMemBank=GetString(ReadTextFile) If CheckParameter("StrMemSize",ReadTextFile) Then StrMemSize=GetString(ReadTextFile) If CheckParameter("StrMemTotalSize",ReadTextFile) Then StrMemTotalSize=GetString(ReadTextFile) If CheckParameter("StrMemSpeed",ReadTextFile) Then StrMemSpeed=GetString(ReadTextFile)   ' Network adpater section If CheckParameter("StrNetworkAdaptTitle",ReadTextFile) Then StrNetworkAdaptTitle=GetString(ReadTextFile) If CheckParameter("StrConnected",ReadTextFile) Then StrConnected=GetString(ReadTextFile) If CheckParameter("StrNetAddress",ReadTextFile) Then StrNetAddress=GetString(ReadTextFile) If CheckParameter("StrDHCPServer",ReadTextFile) Then StrDHCPServer=GetString(ReadTextFile) If CheckParameter("StrNotConnected",ReadTextFile) Then StrNotConnected=GetString(ReadTextFile) If CheckParameter("StrNetAdaptNotFound",ReadTextFile) Then StrNetAdaptNotFound=GetString(ReadTextFile)   'Partitions Menu box strings If CheckParameter("StrPartitionsNameTitle",ReadTextFile) Then StrPartitionsNameTitle=GetString(ReadTextFile) If CheckParameter("StrPartitionsSizeTitle",ReadTextFile) Then StrPartitionsSizeTitle=GetString(ReadTextFile) If CheckParameter("StrHowManyPartitionsTitle",ReadTextFile) Then StrHowManyPartitionsTitle=GetString(ReadTextFile) If CheckParameter("StrHowManyPartition",ReadTextFile) Then StrHowManyPartition=GetString(ReadTextFile) If CheckParameter("StrOneOrTwo",ReadTextFile) Then StrOneOrTwo=GetString(ReadTextFile) If CheckParameter("StrQuestionPartitionSize",ReadTextFile) Then StrQuestionPartitionSize=GetString(ReadTextFile) If CheckParameter("StrQuestGigaOctets",ReadTextFile) Then StrQuestGigaOctets=GetString(ReadTextFile) If CheckParameter("StrQuestPartitionName",ReadTextFile) Then StrQuestPartitionName=GetString(ReadTextFile) If CheckParameter("StrQuestMaxChar",ReadTextFile) Then StrQuestMaxChar=GetString(ReadTextFile) If CheckParameter("StrBootFromTestEnv",ReadTextFile) Then StrBootFromTestEnv=GetString(ReadTextFile) If CheckParameter("StrBootFromCDROM",ReadTextFile) Then StrBootFromCDROM=GetString(ReadTextFile) If CheckParameter("StrBootFromUFD",ReadTextFile) Then StrBootFromUFD=GetString(ReadTextFile) If CheckParameter("StrWarningPartition",ReadTextFile) Then StrWarningPartition=GetString(ReadTextFile) If CheckParameter("StrWarningTitle",ReadTextFile) Then StrWarningTitle=GetString(ReadTextFile)   'UFD transfer Menu boxes strings If CheckParameter("StrRemoveRemovMedia",ReadTextFile) Then StrRemoveRemovMedia=GetString(ReadTextFile) If CheckParameter("StrConnectUFD",ReadTextFile) Then StrConnectUFD=GetString(ReadTextFile) If CheckParameter("StrUFDNotEnoughSpace",ReadTextFile) Then StrUFDNotEnoughSpace=GetString(ReadTextFile) If CheckParameter("StrUFDNotFound",ReadTextFile) Then StrUFDNotFound=GetString(ReadTextFile) If CheckParameter("StrWarningUfdPartition",ReadTextFile) Then StrWarningUfdPartition=GetString(ReadTextFile) If CheckParameter("StrWarningBootUFD",ReadTextFile) Then StrWarningBootUFD=GetString(ReadTextFile)     'Image deployment box strings If CheckParameter("StrDeplWarning",ReadTextFile) Then StrDeplWarning=GetString(ReadTextFile) If CheckParameter("StrDeplChoice",ReadTextFile) Then StrDeplChoice=GetString(ReadTextFile) If CheckParameter("StrDeplAvailImages",ReadTextFile) Then StrDeplAvailImages=GetString(ReadTextFile) If CheckParameter("StrDeplCPartitionToSmall",ReadTextFile) Then StrDeplCPartitionToSmall=GetString(ReadTextFile) If CheckParameter("StrDeplCPartitionNotFound",ReadTextFile) Then StrDeplCPartitionNotFound=GetString(ReadTextFile) If CheckParameter("StrDeplWimFileNotFound",ReadTextFile) Then StrDeplWimFileNotFound=GetString(ReadTextFile) If CheckParameter("StrDeplFormatFault",ReadTextFile) Then StrDeplFormatFault=GetString(ReadTextFile) If CheckParameter("strMultiPartition",ReadTextFile) Then strMultiPartition=GetString(ReadTextFile)   'Backup box strings If CheckParameter("StrBckDriveNotFound",ReadTextFile) Then StrBckDriveNotFound=GetString(ReadTextFile) If CheckParameter("StrBckConnectDrive",ReadTextFile) Then StrBckConnectDrive=GetString(ReadTextFile) If CheckParameter("StrBckDestDrvNotFound",ReadTextFile) Then StrBckDestDrvNotFound=GetString(ReadTextFile) If CheckParameter("StrBckChooseDestPart",ReadTextFile) Then StrBckChooseDestPart=GetString(ReadTextFile) If CheckParameter("StrBckAvailablePartitions",ReadTextFile) Then StrBckAvailablePartitions=GetString(ReadTextFile) If CheckParameter("StrBckEnterWimFileName",ReadTextFile) Then StrBckEnterWimFileName=GetString(ReadTextFile) If CheckParameter("StrBckEnterLabelName",ReadTextFile) Then StrBckEnterLabelName=GetString(ReadTextFile)   'Boot Loader box strings If CheckParameter("StrBootLoaderWinDir",ReadTextFile) Then StrBootLoaderWinDir=GetString(ReadTextFile) If CheckParameter("StrBootLoaderWinDirTitle",ReadTextFile) Then StrBootLoaderWinDirTitle=GetString(ReadTextFile) If CheckParameter("StrFolderDoesntExist",ReadTextFile) Then StrFolderDoesntExist=GetString(ReadTextFile) If CheckParameter("StrBootLoaderBootDir",ReadTextFile) Then StrBootLoaderBootDir=GetString(ReadTextFile) If CheckParameter("StrBootLoaderBootDirTitle",ReadTextFile) Then StrBootLoaderBootDirTitle=GetString(ReadTextFile) If CheckParameter("StrDriveDoesntExist",ReadTextFile) Then StrDriveDoesntExist=GetString(ReadTextFile)     Loop On Error Goto 0 f.Close     End Sub   ' This function checks if the Parameter matchs with the TextLine Function CheckParameter(Parameter,TextLine)   CheckParameter=False If Parameter & "=" = Left(TextLine,Len(Parameter)+1) Then CheckParameter=True End If   End Function   ' This function extracts the message from the text Line Function GetString(TextLine) Dim ptr1,ptr2 ' Finding to position of the message (between " characters) ptr1=InStr(TextLine,Chr(34)) ptr2=InStrRev(TextLine,Chr(34)) ' Checking that the line is valid If ptr1<>0 And ptr2 > ptr1 Then GetString=Mid(TextLine,ptr1+1,ptr2-ptr1-1) Exit Function End If ' The line is not valid" GetString="" End Function

---