DZone Snippets: windows code

Thread Process //Pascal class

jonasraoni (Jonas Raoni Soares Silva) — Mon, 07 Jul 2008 07:25:12 GMT

A thread class to open processes on windows and retrieve its output (input isn't supported but it's easy to add).



unit Process;



interface



uses

  SysUtils, Windows, Classes, TLHelp32;



const

  INITIALIZATION_TIMEOUT = 10000;



type

  TStringArray = array of string;

  TProcessArray = array of Cardinal;

  TExceptionEvent = procedure(Sender: TObject; Exception: Exception) of object;

  EProcessError = class(Exception);



  TProcessThread = class(TThread)

  private

    FException: Exception;

    FWatching, FStarted, FSuspended: Boolean;

    FDirectory, FPath, FCommandLine, FEnvironment: PChar;

    FData: string;

    FOnProcessTerminated, FOnDataAvailable: TNotifyEvent;

    InputRead, InputWrite, OutputRead, OutputWrite: THandle;

    FMainProcess: PROCESS_INFORMATION;

    FOnException: TExceptionEvent;

    FOnProcessStarted: TNotifyEvent;

    function GetPriority: TThreadPriority;

    procedure SetPriority(const Value: TThreadPriority);

    procedure FreeResources;

  protected

    procedure CallDataAvailable; virtual;

    procedure CallProcessTerminated; virtual;

    procedure CallProcessOpened; virtual;

    procedure CallException; virtual;

    procedure Execute; override;

  public

    constructor Create(Path, CommandLine, Directory: string; Environment: TStrings = nil; Watch: Boolean = True);

    destructor Destroy; override;



    function IsProcessAlive: Boolean;

    procedure Resume;

    procedure Suspend;

    property OnDataAvailable: TNotifyEvent read FOnDataAvailable write FOnDataAvailable;

    property OnProcessTerminated: TNotifyEvent read FOnProcessTerminated write FOnProcessTerminated;

    property OnProcessStarted: TNotifyEvent read FOnProcessStarted write FOnProcessStarted;

    property OnException: TExceptionEvent read FOnException write FOnException;

    property Data: string read FData;

    property Process: PROCESS_INFORMATION read FMainProcess;

    property Priority: TThreadPriority read GetPriority write SetPriority;



  end;



  TProcessLineThread = class;

  TOnNewLineEvent = procedure(ProcessLine:  TProcessLineThread; const Line: string) of object;

  TProcessLineThread = class(TProcessThread)

  private

    FCurrentLine: string;

    FOnNewLine: TOnNewLineEvent;

    procedure DataAvailable(Sender: TObject);

    procedure Finished(Sender: TObject);

  public

    constructor Create(Path, CommandLine, Directory: string; Environment: TStrings = nil);

    property OnNewLine: TOnNewLineEvent read FOnNewLine write FOnNewLine;

  end;



function KillProcess(const Process: Cardinal): Boolean;

function GetChildrenProcesses(const Process: Cardinal; const IncludeParent: Boolean = True): TProcessArray;



implementation



const

  Priorities: array [TThreadPriority] of Integer =

   (THREAD_PRIORITY_IDLE, THREAD_PRIORITY_LOWEST, THREAD_PRIORITY_BELOW_NORMAL,

    THREAD_PRIORITY_NORMAL, THREAD_PRIORITY_ABOVE_NORMAL,

    THREAD_PRIORITY_HIGHEST, THREAD_PRIORITY_TIME_CRITICAL);



function GetChildrenProcesses(const Process: Cardinal; const IncludeParent: Boolean): TProcessArray;

var

  Snapshot: Cardinal;

  ProcessList: PROCESSENTRY32;

  Current: Integer;

begin

  Current := 0;

  SetLength(Result, 1);

  Result[0] := Process;

  repeat

    ProcessList.dwSize := SizeOf(PROCESSENTRY32);

    Snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);

    if (Snapshot = INVALID_HANDLE_VALUE) or not Process32First(Snapshot, ProcessList) then

      Continue;

    repeat

      if ProcessList.th32ParentProcessID = Result[Current] then

      begin

        SetLength(Result, Length(Result) + 1);

        Result[Length(Result) - 1] := ProcessList.th32ProcessID;

      end;

    until Process32Next(Snapshot, ProcessList) = False;

    Inc(Current);

  until Current >= Length(Result);

  if not IncludeParent then

    Result := Copy(Result, 2, Length(Result));

end;



function KillProcess(const Process: Cardinal): Boolean;

var

  Handle: Cardinal;

  List: TProcessArray;

  I: Integer;

begin

  Result := True;

  List := GetChildrenProcesses(Process);

  for I := Length(List) - 1 downto 0 do

    if Result then

    begin

      Handle := OpenProcess(PROCESS_TERMINATE, false, List[I]);

      Result := (Handle <> 0) and TerminateProcess(Handle, 0) and CloseHandle(Handle);

    end;

end;



{ TProcessThread }



procedure TProcessThread.CallDataAvailable;

begin

  if Assigned(FOnDataAvailable) then

    FOnDataAvailable(Self);

end;



procedure TProcessThread.Resume;

var

  SuspendCount: Integer;

begin

  if FStarted then

  begin

    FStarted := True;

    SuspendCount := ResumeThread(FMainProcess.hThread);

    CheckThreadError(SuspendCount >= 0);

    if SuspendCount = 1 then

      FSuspended := False;

  end;

  inherited Resume;

end;



function TProcessThread.GetPriority: TThreadPriority;

begin

  if FStarted then

  begin

    CheckThreadError(GetThreadPriority(FMainProcess.hThread) <> THREAD_PRIORITY_ERROR_RETURN);

  end;

  Result := inherited Priority;

end;



function TProcessThread.IsProcessAlive: Boolean;

var

  Status: Cardinal;

begin

  GetExitCodeProcess(FMainProcess.hProcess, Status);

  Result := Status = STILL_ACTIVE;

end;



procedure TProcessThread.SetPriority(const Value: TThreadPriority);

begin

  if FStarted then

    CheckThreadError(SetThreadPriority(FMainProcess.hThread, Priorities[Value]));

  inherited Priority := Value;

end;



procedure TProcessThread.Suspend;

var

  OldSuspend: Boolean;

begin

  if FStarted then

  begin

    OldSuspend := FSuspended;

    try

      FSuspended := True;

      CheckThreadError(Integer(SuspendThread(FMainProcess.hThread)) >= 0);

    except

      FSuspended := OldSuspend;

      raise;

    end;

  end;

  inherited Suspend;

end;





procedure TProcessThread.CallException;

begin

  if Assigned(FOnException) then

    FOnException(Self, FException);

end;



procedure TProcessThread.CallProcessOpened;

begin

  if Assigned(FOnProcessStarted) then

    FOnProcessStarted(Self);

end;



procedure TProcessThread.CallProcessTerminated;

begin

  if Assigned(FOnProcessTerminated) then

    FOnProcessTerminated(Self);

end;



constructor TProcessThread.Create(Path, CommandLine, Directory: string; Environment: TStrings; Watch: Boolean);

var

  Len, I: Integer;

begin

  inherited Create(True);



  if (Length(CommandLine) > 0) and (Length(Path) > 0) then

    CommandLine := ' ' + CommandLine;



  if Length(Path) > 0 then

  begin

    GetMem(FPath, Length(Path) + 1);

    StrCopy(FPath, PChar(Path));

  end;

  if Length(CommandLine) > 0 then

  begin

    GetMem(FCommandLine, Length(CommandLine) + 1);

    StrCopy(FCommandLine, PChar(CommandLine));

  end;



  if Length(Directory) > 0 then

  begin

    GetMem(FDirectory, Length(Directory) + 1);

    StrCopy(FDirectory, PChar(Directory));

  end;



  FWatching := Watch;



  if Assigned(Environment) then

  begin

    GetMem(FEnvironment, 1);

    Len := 1;

    for I := 0 to Environment.Count - 1 do

    begin

      Inc(Len, Length(Environment[I]) + 1);

      ReallocMem(FEnvironment, Len);

      SetEnvironmentVariable(PChar(Environment.Names[I]), PChar(Environment.ValueFromIndex[I]));

      StrCopy(FEnvironment + Len - Length(Environment[I]) - 2, PChar(Environment[I]));

    end;

    (FEnvironment + Len - 1)^ := #0;

    FreeMem(FEnvironment);

    FEnvironment := nil;

  end;

end;



destructor TProcessThread.Destroy;

begin

  FreeMem(FPath);

  FreeMem(FCommandLine);

  FreeMem(FDirectory);

  FreeResources;

  if Assigned(FEnvironment) then

    FreeMem(FEnvironment);

  inherited;

end;



procedure TProcessThread.Execute;

const

  MAX_BUFFER = 512 * 1024;

var

  MaxBytes, Available, BytesRead: Cardinal;

  Buffer: array[0..MAX_BUFFER] of Char;



  function Read: Boolean;

  begin

    Result := True;

    FillChar(Buffer, MAX_BUFFER, #0);

    PeekNamedPipe(OutputRead, @Buffer, MAX_BUFFER, @BytesRead, @Available, nil);



    if BytesRead < MAX_BUFFER then

    begin

      MaxBytes := BytesRead;

    end

    else

      MaxBytes := MAX_BUFFER;



    if MaxBytes > 0 then

      if ReadFile(OutputRead, Buffer, MaxBytes, BytesRead, nil) then

      begin

        if BytesRead > 0 then

        begin

          FData := StrPas(Buffer);

          Synchronize(CallDataAvailable);

        end;

      end

      else

        Result := False;

  end;



var

  Startup: STARTUPINFO;

  SecurityDescriptor: SECURITY_DESCRIPTOR;

  SecurityAttributes: SECURITY_ATTRIBUTES;

begin

  try

    ZeroMemory(@Startup, SizeOf(STARTUPINFO));

    Startup.cb := SizeOf(STARTUPINFO);

    ZeroMemory(@SecurityDescriptor, SizeOf(SECURITY_DESCRIPTOR));

    ZeroMemory(@SecurityAttributes, SizeOf(SECURITY_ATTRIBUTES));

    InputRead := 0;

    InputWrite := 0;

    OutputRead := 0;

    OutputWrite := 0;



    if Win32Platform = VER_PLATFORM_WIN32_NT then

    begin

      InitializeSecurityDescriptor(@SecurityDescriptor, SECURITY_DESCRIPTOR_REVISION);

      SetSecurityDescriptorDacl(@SecurityDescriptor, True, nil, False);

      SecurityAttributes.lpSecurityDescriptor := @SecurityDescriptor;

    end

    else

      SecurityAttributes.lpSecurityDescriptor := nil;

    SecurityAttributes.nLength := SizeOf(SECURITY_ATTRIBUTES);

    SecurityAttributes.bInheritHandle := True;

    if not CreatePipe(OutputRead, OutputWrite, @SecurityAttributes, 0)

    or not CreatePipe(InputRead, InputWrite, @SecurityAttributes, 0) then

      raise EProcessError.Create('Error while opening pipes');



    SetHandleInformation(OutputRead, HANDLE_FLAG_INHERIT, 0);

    SetHandleInformation(InputWrite, HANDLE_FLAG_INHERIT, 0);



    GetStartupInfo(Startup);

    Startup.dwFlags := STARTF_USESHOWWINDOW OR STARTF_USESTDHANDLES;



    Startup.hStdOutput := OutputWrite;

    Startup.hStdError := OutputWrite;

    Startup.hStdInput := InputRead;



    FlushFileBuffers(OutputWrite);

    FlushFileBuffers(OutputRead);

    FlushFileBuffers(InputRead);

    FlushFileBuffers(InputWrite);



    Startup.wShowWindow := SW_HIDE;



    if not CreateProcess(FPath, FCommandLine, nil, nil, True, CREATE_NEW_CONSOLE OR NORMAL_PRIORITY_CLASS, FEnvironment, FDirectory, Startup, FMainProcess) then

      raise EProcessError.Create('Error while starting Process: ' + SysErrorMessage(GetLastError) + ':' + FPath + ':' + FCommandLine + ':' + FDirectory);

    WaitForInputIdle(FMainProcess.hProcess, INITIALIZATION_TIMEOUT);

    FStarted := True;

    SetPriority(GetPriority);

    Synchronize(CallProcessOpened);

    

    if not FWatching then

      Exit;



    repeat

      if not Read then

        Break;

    until not IsProcessAlive or Terminated;

    Read;



    if not IsProcessAlive then

      Synchronize(CallProcessTerminated);

      

  except

    on E: Exception do

    begin

      FException := E;

      Synchronize(CallException);

    end;

  end;

end;



procedure TProcessThread.FreeResources;

begin

  KillProcess(FMainProcess.dwProcessId);



  if OutputRead <> 0 then

  begin

    CloseHandle(OutputRead);

    OutputRead := 0;

  end;

  if OutputWrite <> 0 then

  begin

    CloseHandle(OutputWrite);

    OutputWrite := 0;

  end;

  if InputWrite <> 0 then

  begin

    CloseHandle(InputWrite);

    InputWrite := 0;

  end;

  if InputRead <> 0 then

  begin

    CloseHandle(InputRead);

    InputRead := 0;

  end;

end;



{  TProcessLineThread }



constructor  TProcessLineThread.Create(Path, CommandLine, Directory: string; Environment: TStrings);

begin

  inherited Create(Path, CommandLine, Directory, Environment);

  OnDataAvailable := DataAvailable;

  OnTerminate := Finished;

end;



procedure  TProcessLineThread.DataAvailable(Sender: TObject);

var

  I, L: Integer;

begin

  I := 0;

  L := Length(Data);

  while I < L do

  begin

    Inc(I);

    if Data[I] in [#13, #10] then

    begin

      if (I < L) and (Data[I+1] in [#13, #10]) then

        Inc(I);

      if Assigned(FOnNewLine) then

        FOnNewLine(Self, FCurrentLine);

      FCurrentLine := '';

    end

    else

      FCurrentLine := FCurrentLine + Data[I];

  end;

end;



procedure  TProcessLineThread.Finished(Sender: TObject);

begin

  if (FCurrentLine <> '') and Assigned(FOnNewLine) then

    FOnNewLine(Self, FCurrentLine);

end;



end.

Interactive Text-to-Speech (Windows, Perl)

minitotoro (Natalie) — Mon, 28 Jan 2008 19:59:29 GMT

This script calls the Windows OLE for the built in TTS. Type what you want the computer to say at the prompt and hit enter. To quit type ":q" (minus the quotation marks).



use Win32::OLE qw( EVENTS );



get_text();



sub get_text{

	$output_speech = ;

	chomp($output_speech);

	if($output_speech ne ":q"){

		say_this();

		get_text();

	}

}



sub say_this{

	my $myTTS = new Win32::OLE( "Sapi.SpVoice" ); 

	$myTTS->Speak( "$output_speech" );

	while( $myTTS->{Speaking} )

	{

		Win32::OLE->SpinMessageLoop();

		Win32::Sleep( 100 );

	}

}

Find & Replace in Word Document with Ruby

timmorgan (Tim Morgan) — Mon, 12 Nov 2007 14:48:47 GMT

I use this to open a "template" (really just a plain Word document with [text to replace] inside), do the substitutions, and save as a new filename.



require 'win32ole'



word = WIN32OLE.new('Word.Application')

#word.Visible = true # uncomment if you want to see it happen

doc = word.Documents.Open('c:\file_to_open.doc')

{

  'name' => 'Tim Morgan',

  'date' => Date.today.strftime('%B %d, %Y'),

  ...

}.each do |key, value|

  word.Selection.HomeKey(unit=6) # start at beginning

  find = word.Selection.Find

  find.Text = "[#{key}]" # text must be in square brackets

  while word.Selection.Find.Execute

    word.Selection.TypeText(text=value)

  end

end

doc.SaveAs('c:\output_file.doc')

doc.Close

Internet Explorer automation using win32::OLE

bouffon69 (Sylvain Le Courtois) — Fri, 28 Sep 2007 11:45:24 GMT

// Sample code used for one of my client



#!/usr/bin/perl -w



use strict;

use Data::Dumper;

use Win32::OLE qw( EVENTS );



my ($day, $mon, $year, $hour, $min, $sec) = (localtime)[3, 4, 5, 2, 1, 0];

$mon++; # 0-based index

$year = $year + 1900;

my $date = sprintf ("%04i-%02i-%02i %02i\:%02i\:%02i", $year, $mon, $day, $hour, $min, $sec);



my $Disconnect;

my $Menu;

my $TreeView;

my $WatchDog;

my $MenuClicked=0;



my $ScenarioCompleted=0;



my @TreeViewLinks=("Appareillage du B","Branchement Comptage","Branchement individuel");

my $Previouslink=$TreeViewLinks[0];



my $ie = Win32::OLE->new( 'InternetExplorer.Application' ) or die "error starting IE";

$ie->{visible} = 1;



Win32::OLE->Option( Warn => 3 );



$WatchDog=time();

Win32::OLE->WithEvents( $ie, \&Event, 'DWebBrowserEvents2' );

$ie->navigate( 'http://www.xxx.fr' );

Win32::OLE->MessageLoop();

unlink("noemis.err") if -f "noemis.err";

if ( ! $ScenarioCompleted ) {

	open( ERR , ">noemis.err" ); 

	print ERR "Problem executing Noemis scenario, please check www.xxx.fr.\n" ;

	close(ERR);

}

$Disconnect->Click();

Win32::OLE->SpinMessageLoop;



# Maintenance du fichier historique

open ( STATS , "noemis.txt" );

my @lines=;

close (STATS);

open( STATS , ">noemis.txt" ); 

for my $line (@lines) {

	my ($datetime) = split ( /;/ , $line );

	my ($h_year,$h_mon) = $datetime =~ /^([0-9]{4})-([0-9]{2})/;

	print STATS $line if ($year*12+$mon) - ($h_year*12+$h_mon) < 2;

}

print STATS join(";",$date,"Noemis Scenario",( time() - $WatchDog ))."\n";

close( STATS );



sleep 2;

Win32::OLE->SpinMessageLoop;

sleep 1;

$ie->Quit();

exit 0;





sub Event {

	my ($Obj,$Event,@Args) = @_;

	my $IEObject = shift @Args;

	print " Event triggered: $Event\n";    



	my ($i,$anchor);

	my $anchors;

    

	# STEP 1 : Find the main menu, login to the web site, find the treeview

	if ($Event eq "DocumentComplete") {    

		print "URL: " . $IEObject->Document->URL . "\n";

		if ( $IEObject->Document->URL eq "http://www.xxx.fr/ident.aspx" ) {

			my $forms = $IEObject->Document->forms;

			my $form = $forms->item(0);

			if ( defined($form->elements("fldNumCli")) ) {

				print "--------------------------------------------\n";

				print "Found the login box, authenticating ...\n";

				print "--------------------------------------------\n";

			    $form->elements("fldNumCli")->{value} = "xxxx";

			    $form->elements("fldUtil")->{value} = "xxx";

			    $form->elements("fldPwd")->{value} = "xxx";

		    	$form->elements("btIdent")->Click();

	    		}

		}

		if ( $IEObject->Document->URL eq "http://www.xxx.fr/menu.aspx" ) {

			print "Found the menu.\n";

			$Menu = $IEObject->Document;

			$anchors = $IEObject->Document->links;

			for (my $i=0; $i < $anchors->length; $i++) {

				$anchor = $anchors->item($i);

				print $anchor->href."\n";

				$Disconnect = $anchor if $anchor->href eq "http://www.xxx.fr/ident.aspx?qs=deconnecter";

			}

	      	}	    

		if ( $IEObject->Document->URL eq "http://www.xxx.fr/client/frameTreeview.aspx" ) {

			print "Found the TreeView.\n";

			$TreeView = $IEObject->Document;

      		}		

	}



	# STEP 2 : Click on the Menu and TreeView links   

	if ($Event eq "DocumentComplete") {    		

	if ( ! $MenuClicked and defined($Menu) ) {

		my $MenuItem = $Menu->getElementById("SM_CLIE_RECH");

		if ( defined($MenuItem) ) { 

			print $MenuItem->ID."\n";

			$MenuItem->Click;

			$MenuClicked = 1;

		}

	}}



	if ( $Event eq "CommandStateChange" or $Event eq "StatusTextChange" ) {

		print Dumper($IEObject);

	}

	if ( @TreeViewLinks != 0 and 

	     defined($TreeView) and 

	     $Event eq "DocumentComplete" 

	) {

		my $link = shift(@TreeViewLinks);

		$anchors = $TreeView->links;

		my $found=0;

		print "Looking for '$link' in the TreeView ... \n";

	        for (my $i=0; $i < $anchors->length; $i++) {

		       	$anchor = $anchors->item($i);

	        	#print $anchor->innerHTML."\n";

		       	if ( $anchor->innerHTML =~ /$link/ ) {

				print "Clicking on '$link' ... \n";

	                	$anchor->Click;

				$found=1;

				$Previouslink=$link;

				last;

			}

	        }

		if ( ! $found ) { 

			# Le TreeView a bugge, on reclique

			sleep 1;

			print "Looking for '$Previouslink' in the TreeView ... \n";

		        for (my $i=0; $i < $anchors->length; $i++) {

			       	$anchor = $anchors->item($i);

	        		#print $anchor->innerHTML."\n";

		       		if ( $anchor->innerHTML =~ /$Previouslink/ ) {

					print "Clicking on '$Previouslink' ... \n";

	              		  	$anchor->Click;

					last;

				}

		        }

			unshift @TreeViewLinks,$link;

		}

	} 

   

	# STEP 3 : Verify the list displayed 

		

	if ($Event eq "DocumentComplete") {    

   		if ( @TreeViewLinks == 0 and $IEObject->Document->URL =~ /listeRefPlof.aspx/ ) {

			print "Scenario completed, exiting ...\n";

			$ScenarioCompleted=1;

	   		Win32::OLE->QuitMessageLoop;

		}

	}

    



	# Exit on errors

	    

	Win32::OLE->QuitMessageLoop() if $Event eq "OnQuit" or time() > $WatchDog + 60;

    

}

ASP Page listing and making changes to AD accounts

bouffon69 (Sylvain Le Courtois) — Thu, 20 Sep 2007 07:02:54 GMT

// Used for automated AD account migration



Workstation User Account migration

href="files/v2006.css" type=text/css rel=stylesheet>





<%

' ------------------------------------------------------------------------

Const ADS_PROPERTY_CLEAR = 1



Const SOURCE_OU="ou=NT Users,ou=NT,dc=fr,dc=erm,dc=int"

Const TARGET_OU="ou=SUPPORT SERVICES,dc=fr,dc=erm,dc=int"



Const HOMES_PATH="\\frsrvfil0001\USERS\"

Const PROFILES_PATH="\\frsrvfil0001\PROFILES\"



Const ADMIN_HOMES_PATH_SOURCE="\\frsrvfil0001\U$\NT\"

Const ADMIN_PROFILES_PATH_SOURCE="\\frsrvfil0001\P$\NT\"

Const ADMIN_HOMES_PATH_DEST="\\frsrvfil0001\U$\"

Const ADMIN_PROFILES_PATH_DEST="\\frsrvfil0001\P$\"



Const SCRIPT_NAME="ntuser_to_xp.asp"



Dim State

State="Init"

Dim OU, Member

 

If Request.QueryString("login") <> "" Then

		' Affichage formulaire pour modif du compte

		State="Info"

End If

If Request.Form("login") <> "" Then

		' On a cliqué sur OK pour valider le formulaire

		State="Modify"

End If

' ------------------------------------------------------------------------

%>

border=0>






  
  
    

      






        
        
                      width=160> 
          



<%

	If State="Init" Then

	'-----------------------------------------------------------------------------------

	' Listing of the NT Users

	'-----------------------------------------------------------------------------------

%>          



                        border=0>









              
              
                

                    <%

                    'Response.Write(SOURCE_OU & "
") 

                    %>

					Please select the NT 4.0 Workstation user account to migrate

                
                
              
                

                                  <%

                  Set OU = GetObject("LDAP://" & SOURCE_OU)

                  OU.Filter = Array("user")

    	          For Each Member In OU

    	          		' Bug with the SMS Account ??

    	          		If Member.Name <> "CN=SMSService" Then 

    	          		If Member.AccountDisabled = 0 Then

	    	                Response.Write("" & Member.FullName & "
")

	    	            End If

	    	            End If 

            	  Next      

                  

                  %>



                
                
                
                



<%

End If

%>                

                

<%

	If State="Info" Then

	'-----------------------------------------------------------------------------------

	' Information page about the NT Users

	'-----------------------------------------------------------------------------------

%>          

			



                        border=0>





                  <%

                  Sub TabRow(v1,v2)

                  		Response.Write("")

                  		Response.Write("")

                  End Sub

                  Set Member = GetObject("LDAP://" & Request.QueryString("login") & "," & SOURCE_OU)


                  TabRow "User Name",Member.FullName

                  TabRow "NT Login",Member.sAMAccountName

				  TabRow "Login Script", Member.LoginScript & " (to delete)"

				  TabRow "Profile Path", Member.Profile

				  TabRow "New Path",PROFILES_PATH & Member.sAMAccountName

				  TabRow "Home Folder", Member.HomeDirectory

				  TabRow "New Path",HOMES_PATH & Member.sAMAccountName


				  ' Liste des OU dans SUPPORT SERVICES

 				  Dim OUSuppServices, Entity, BoxList

 				  Set OUSuppServices=GetObject("LDAP://" & TARGET_OU)

				  OUSuppServices.Filter = Array("organizationalUnit")

				  BoxList=""

				  TabRow "Organizational Unit",BoxList


                  %>



              
              
                

                 	<%

                 	Response.Write("Windows NT 4.0 User Account Migration")

                    %>

					

                
               
" & v1 & "")

                  		Response.Write(" " & v2 & "
				  
                                    

                
                

                


                 >

                

                 Cliquer ici pour migrer ce compte.



                ATTENTION, l'utilisateur ne doit pas être connecté ! 

                <% Response.Write("

" & "Cliquer ICI pour annuler" & "
") %>

                



<%

End If

%>                



<%



	If State="Modify" Then

	'-----------------------------------------------------------------------------------

	' Migration of the NT Users

	'-----------------------------------------------------------------------------------

Sub dirMoveTree(source, dest)

	Response.Write "Deplacement de " & source & " vers " & dest & "
"

	Dim Folder,File,SubFolder

	set Folder=fso.GetFolder(source)

	For Each File In Folder.Files

	      Response.Write File.Name & " File -> " & dest & "
"

	      file.move dest & "\"

	Next

	For Each SubFolder In Folder.SubFolders

	      Response.Write SubFolder.Name & " Folder -> " & dest & "
"

	      SubFolder.move dest & "\"

	Next

End Sub



%>          



Windows NT 4.0 User Account Migration



<%



' Modification des proprietes l'utilisateur dans AD

Set Member = GetObject("LDAP://" & Request.QueryString("login") & "," & SOURCE_OU)



' ADS_PROPERTY_CLEAR

Member.PutEx 1, "scriptPath", 0

Member.SetInfo



Member.Put "profilePath", PROFILES_PATH & Member.sAMAccountName

Member.Put "homeDirectory", HOMES_PATH & Member.sAMAccountName

' 

Member.SetInfo

' 

Response.Write("Utilisateur " & Member.sAMAccountName & " Modifié dans AD

")



' Deplacement dans le bon conteneur

Set OU = GetObject("LDAP://" & "OU=Users," & Request.Form("entity") & "," & TARGET_OU)

OU.MoveHere "LDAP://" & Request.QueryString("login") & "," & SOURCE_OU, Request.QueryString("login")

Response.Write("Utilisateur " & "LDAP://" & Request.QueryString("login") & "," & SOURCE_OU & " Deplacé dans " & "LDAP://" & "OU=Users," & Request.Form("entity") & "," & TARGET_OU & "

")



DIM fso, File, Folder, SubFolder

Set fso = CreateObject("Scripting.FileSystemObject")



' Creation des repertoires cible



fso.CreateFolder(ADMIN_HOMES_PATH_DEST & Request.Form("login"))

fso.CreateFolder(ADMIN_PROFILES_PATH_DEST & Request.Form("login"))



' Deplacement des données



dirMoveTree ADMIN_HOMES_PATH_SOURCE & Request.Form("login"),ADMIN_HOMES_PATH_DEST & Request.Form("login")

dirMoveTree ADMIN_PROFILES_PATH_SOURCE & Request.Form("login"),ADMIN_PROFILES_PATH_DEST & Request.Form("login")



' Applications des ACLs, en arriere plan car ca peut etre long !

Response.Write("
Creation du script d'application des ACLs C:\Inetpub\wwwroot\techcity\xcacls_" & Request.Form("login") & ".cmd

")

Set server_shell = Server.CreateObject("wscript.shell")



server_shell.Run "cmd /c echo echo Excecution Cacls >C:\Inetpub\wwwroot\techcity\xcacls_" & Request.Form("login") & ".cmd 2>&1",,1

server_shell.Run "cmd /c echo xcacls.exe """ & ADMIN_HOMES_PATH_DEST & Request.Form("login") & """ /T /C /G SYSTEM:F ADMINISTRATORS:F FR-ERM\" & Request.Form("login") & ":C /Y >>C:\Inetpub\wwwroot\techcity\xcacls_" & Request.Form("login") & ".cmd 2>&1",,1

server_shell.Run "cmd /c echo xcacls.exe """ & ADMIN_PROFILES_PATH_DEST & Request.Form("login") & """ /T /C /G SYSTEM:F ADMINISTRATORS:F FR-ERM\" & Request.Form("login") & ":F /Y >>C:\Inetpub\wwwroot\techcity\xcacls_" & Request.Form("login") & ".cmd 2>&1",,1



' server_shell.Run "C:\Inetpub\wwwroot\techcity\xcacls.cmd >C:\Inetpub\wwwroot\techcity\xcacls.log 2>&1",,1

Response.Write("
Les ACLs seront appliquee dans 5 min (scheduled)...

")

Response.Write("Attendre egalement la fin de replication de AD ...

")



Response.Write("
Terminé !
")



%>

<% Response.Write("

" & "Cliquer ICI pour quitter" & "
") %>



<%

End If

%>

Simple ASP page to reset passwords

bouffon69 (Sylvain Le Courtois) — Thu, 20 Sep 2007 07:01:29 GMT

// This page allows to reset an AD account password.



Reinitialisation de mot de passe

href="files/v2006.css" type=text/css rel=stylesheet>







border=0>



  
  
    

      




        
        
                      width=160> 
          

                        border=0>










              
              
                

                <%

                If Request.Form("login") = "" Then

                	Response.Write("Saisir le compte à reinitialiser")

                Else

                    Dim Group, Member, Domain, UserFound

                    ' 

                    Domain ="FR-ERM"

                    '

                    UserFound=0

                    

	                Set Group = GetObject("WinNT://" & Domain & "/Domain Users")

    	            For Each Member In Group.Members

    	            	' Response.Write(Member.Name & "
")

        	        	If UCase(Member.Name) = UCase(Request.Form("login")) Then

        	        		UserFound=1

        	        		If Member.AccountDisabled Then 

        	        			Response.Write(" " & Request.Form("login") &" est un compte desactive")

        	        			Exit For

        	        		Else

        	        			' Essai de reinit de mot de passe

        	        			Dim res

        	        			res=Member.SetPassword(Request.Form("pass"))

        	        			'Member.Put "pwdLastSet", CLng(0)

        	        			Member.Put "PasswordExpired", 1

								Member.SetInfo

        	        			Response.Write("L'utilisateur "& Request.Form("login") & " a changé de mot de passe !

Il devra changer de mot de passe au prochain login.")

        	        			Exit For

        	        		End If

        	        	End If 

            	    Next      

       	        	If UserFound = 0 Then

       	        		Response.Write(Request.Form("login") &" non trouvé dans le domaine "& Domain)

       	        	End If           	            	

                	

                End If

                %>

              

                
              
                Identifiant

               

                
                Nouveau mot de passe
              
                

 

                
                                  name=pass> 
                                  src="files/submit.gif" value=login border=0 name=ok>

Automating Outlook with Ruby: Inbox & Messages

dmullet (David Mullet) — Sat, 15 Sep 2007 12:32:37 GMT

From the Ruby on Windows blog.



require 'win32ole'

outlook = WIN32OLE.new('Outlook.Application')

mapi = outlook.GetNameSpace('MAPI')



# Get a reference to the Inbox or other folder:

inbox = mapi.GetDefaultFolder(6)

personal_folders = mapi.Folders.Item('Personal Folders')

baseball_folder = personal_folders.Folders.Item('Baseball')



# Get a count of a folder's unread items:

puts "#{inbox.UnreadItemCount} unread messages"



# Iterate over messages in a folder:

inbox.Items.each do |message|

    # Your code here...

end



# Retrieve a single message:

first_message = inbox.Items(1)



# Delete a message:

message.Delete



# Move a message to another folder:

baseball_folder = personal_folders.Folders.Item('Baseball')

message.Move(baseball_folder)



inbox.Items.Count.downto(1) do |i|

    message = inbox.Items(i)

    if message.Subject =~ /cardinals/i

        message.Move(baseball_folder)

    end

end

Further details and discussion can be found here.

Open/Creates a Base Key in the Registry

dubby (Dave) — Tue, 11 Sep 2007 11:58:28 GMT

// open a Base Key in the registry



       public static RegistryKey GetKey(string baseKey)

        {

            RegistryKey key;

            try

            {

                key = Registry.LocalMachine.OpenSubKey(baseKey, true);



                if (key == null)

                {

                    key = Registry.LocalMachine.CreateSubKey(baseKey);

                }

                else

                {

                    MessageBox.Show("Base key resolved");

                }

            }

            catch (Exception e)

            {

                return null;

            }

            return key;

        }

MSSQL 2005 - Add ID value to ID column when INSERTING

dubby (Dave) — Tue, 11 Sep 2007 07:50:29 GMT

// @TableName is obviously the TABLE name u use
// @ColumnName is obviously the COLUMN name u use



---Get next ID number

	DECLARE 

		@ID int

	

	IF (SELECT count(*) FROM @TableName ) > 0

		BEGIN

			SELECT @ID  = max(ColumnName ) from @TableName

			SET @ID = @ID + 1 

		END

	ELSE

	BEGIN

		SET @ID  = 1

	END

Windows XP System Variables

dubby (Dave) — Fri, 07 Sep 2007 09:09:44 GMT

// Windows XP Default System Variables



%SystemDrive%  		C:



%SystemRoot% 		C:\WINNT, C:\WINDOWS



%SystemDirectory% 	C:\WINNT\System32, C:\WINDOWS\System32



%WinDir% 		C:\WINNT, C:\WINDOWS, C:\WINNT\Program Files



%ComSpec% 		C:\WINNT\system32\cmd.exe



%Temp% 			C:\DOCUME~1\Usr\LOCALS~1\Temp from C:\Documents and Settings\Usr\Local Settings\Temp



%HOMEDRIVE% 		C: The drive letter associated with the user's home directory



%HOMEPATH% 		The path to the user's home directory (excluding drive): \Documents and Settings\Guest



%OS% 			Windows_NT -> The operating system the user is running



%USERDOMAIN% 		The name of the domain that contains the user's account



%USERNAME% 		The user's name