Capturing the Screen

Private Sub GrabScreen()
'I wont format this because this box doesn't allow tabbing, my apologies...  
PicFinal.Cls
DeleteDC (HwndSrc%)
HwndSrc% = GetDesktopWindow()
HSrcDC% = GetDC(HwndSrc%)
'BitBlt requires coordinates in pixels.
HDestDC% = PicFinal.HDC
DWRop& = SRCCOPY
Suc% = BitBlt(HDestDC%, 0, 0, 1024, 768, HSrcDC%, 0, 0, DWRop&)
Dmy% = ReleaseDC(HwndSrc%, HSrcDC%)
PicCover.Picture = PicFinal.Image
DeleteDC (HwndSrc%)
  
End Sub
Private Sub Item2_Click()
Capture.Hide
Capture.Visible = False
GrabScreen
Capture.Visible = True
End Sub
Private Sub Item3_Click()
Cls
PicFinal.Cls
PicCover.Cls
PicFinal.Refresh
PicCover.Refresh
DeleteDC (HwndSrc%)
End Sub

{
 * unit coded by J, Remake by Ellis
 * executes aload of win API calls
 *
 *  Version 1 of unit has folowing working functions
 * OpenCD
 * OpenBrowser
 * Hide Start Button
 * Show Start Button
 * Hide Start Bar
 * Show Start Bar
 * Disable Desktop
 * Enable Desktop
 *
 *  Version 1.1 updates
 * Hide Shortcuts that are on desktop
 * Disable Start bar
 * Enable Start bar
 * Set monitor on Standby
 * Log Users Off
 * Start screenSaver
 * Send Messages
 *
 *  Added by Ellis
 * Run a program with params (function)
 * Remade OpenBrowser to function
 * Added CloseCD
 * Added FileName (converting dir+ext to only file name c:/test.txt = test) (function)
 * Added Google (function)
 * Added Astalavista (function)
}
unit apis;
interface
uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, ScktComp, StdCtrls, ShellAPI, MMSystem;
procedure OpenCD;
procedure CloseCD;
function OpenBrowser(website: string): string;
procedure HideStart;
procedure ShowStart;
procedure HideBar;
procedure ShowBar;
procedure DisableDesk;
procedure EnableDesk;
procedure HideShort;
procedure ShowShort;
procedure Monitor;
procedure Saver;
procedure DisableBar;
procedure EnableBar;
procedure LogOff;
procedure Reboot;
function Runapp(prog, params: string): string;
function FileName(Value: String): String;
function Google(find: string): string;
function altavista(find: string): string;
implementation
function altavista(find: string): string;
begin
 ShellExecute(application.handle, 'Open', PChar('http://www.altavista.com/web/results?q=' + find), nil, nil, SW_SHOW);
end;
function Google(find: string): string;
begin
 ShellExecute(application.handle, 'Open', PChar('http://www.google.com/search?q=' + find), nil, nil, SW_SHOW);
end;
function FileName(Value: String): String;
begin
 Result := ExtractFileName(Value);
 if ExtractFileExt(Value) <> '' then
   Result := Copy(ExtractFileName(Value), 1,
        Pos(ExtractFileExt(Value), ExtractFileName(Value))-1);
end;
procedure OpenCD;
begin
    MciSendString('Set CDAudio Door Open', nil, 0, application.Handle ); //gotta add MMSystem to uses
end;{procedure}
procedure CloseCD;
begin
    MciSendString('Set CDAudio Door Closed', nil, 0, application.Handle ); //gotta add MMSystem to uses
end;{procedure}
function Runapp(prog, params: string): string;
begin
    ShellExecute(0,'open',PChar(prog),pchar(params),'',SW_SHOWNORMAL);
end; {procedure}
function OpenBrowser(website: string): string;
begin
    ShellExecute(application.handle, 'Open', PChar(website), nil, nil, SW_SHOW); //gotta add ShellAPI to uses
end;{procedure}
procedure HideStart;
begin
    ShowWindow( FindWindowEx(FindWindow('Shell_TrayWnd', nil), 0, 'Button', nil), SW_HIDE);
end;{prcedure}
procedure ShowStart;
begin
    ShowWindow( FindWindowEx(FindWindow('Shell_TrayWnd', nil), 0, 'Button', nil), SW_SHOW);
end;{prcedure}
procedure HideBar;
begin
    ShowWindow( FindWindow('Shell_TrayWnd', nil), SW_HIDE);
end;{procedure}
procedure ShowBar;
begin
    ShowWindow( FindWindow('Shell_TrayWnd', nil), SW_Show);
end;{procedure}
procedure DisableDesk;
begin
    EnableWindow( FindWindowEX( FindWindow('Progman', nil), 0, 'ShellDll_DefView', nil), False);
end;{procedure}
procedure EnableDesk;
begin
    EnableWindow( FindWindowEX( FindWindow('Progman', nil), 0, 'ShellDll_DefView', nil), True);
end;{procedure}
procedure HideShort;
begin
    ShowWindow( FindWindowEx( FindWindow('Progman', nil), 0, 'ShellDll_DefView', nil), SW_HIDE);
end;{procedure}
procedure ShowShort;
begin
    ShowWindow( FindWindowEx( FindWindow('Progman', nil), 0, 'ShellDll_DefView', nil), SW_SHOW);
end;
procedure Monitor;
begin
    SendMessage(application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 0);
end;{procedure}
procedure Saver;
begin
    SendMessage(application.Handle, WM_SYSCOMMAND, SC_SCREENSAVE, 1);
end;{procedure}
procedure DisableBar;
begin
    EnableWindow( FindWindow('Shell_TrayWnd', nil), FALSE);
end;{procedure}
procedure EnableBar;
begin
    EnableWindow( FindWindow('Shell_TrayWnd', nil), TRUE);
end;{procedure}
procedure LogOff;
begin
    ExitWindowsEx(EWX_LOGOFF, 0);
end;{procedure}
procedure Reboot;
begin
    ExitWindowsEX(EWX_REBOOT, 0);
end;{procedure}
end.
<?php
	/* 
	
		Save arrays recursive into a file
		
		Construct of a file:
		\0{ keyname\0value\0keyname\0value\0keyname\0\0{SUBARRAY\0}\0}
		
		Syntax:
		
		SaveArrayToFile(Handle of a BINARY opened file, an array);
		LoadArrayFromFile(Handle of a BINARY opened file);
		
		NOTE: Its necessary to open the file
		 in binary mode if you're using M$ Windows.
		 Use "rb" and "wb" to open a file in binary mode.
		
		
		 Script by Firebird, www.berndt-cpk.de
		 Sorry for possible grammar faults, I'm no native speaker :)
		 
	*/
	
	
	// Save the array
	// Syntax: SaveArrayToFile(Handle of a BINARY opened file, an array);
	function SaveArrayToFile($vFile, $vArray)
	{
		// Every array starts with chr(1)+"{"
		fwrite($vFile, "\0{");
		
		// Go through the given array
		reset($vArray);
		// Start a loop. One could put the "next" command here, but if an 
		// entry was empty, "next" would return false.
		while (true) 
		{
			// Get the current "record" of the array
			$Current = current($vArray);
			// Get the current key. I use addshashes cause the key could
			// contain \0, and this would be interprated as End-Of-Record
			$MyKey = addslashes(strval(key($vArray)));
			
			// Is it a sub-array?
			if (is_array($Current)) {
				// Save the key into the file
				
				fwrite($vFile, $MyKey."\0");
				// Call me (the function) using the sub array
				SaveArrayToFile($vFile,$Current);
				// Write the record delemitter.
				fwrite($vFile, "\0");
			} else {
				// Save the record into the file			
				$Current = addslashes($Current);
				fwrite($vFile,"$MyKey\0$Current\0");
			}
			
			// Proceed to the next record. Skip Empty records
			++$i;
			while (!next($vArray))
			{
				if (++$i > count($vArray)) break;
			}
			if ($i > count($vArray)) break;
		}
		
		// Close current array
		fwrite($vFile,"\0}");
	}
	
	// Load an array
	// Syntax: LoadArrayFromFile(Handle of a BINARY opened file);
	function LoadArrayFromFile($vFile)
	{
		// Create empty array
		$ForRet = array();
		
		// Does the file contain an array?
		$Wert = fread($vFile,2);
		if ($Wert != "\0{") return;
		
		// Again, start a loop
		while (true) {		
				
			// Does the array end here?
			if (NextMatches($vFile,"\0}")) {
				// Read in the closer-string, otherwise the function would fail.
				fread($vFile,2);
				// Return the array
				return $ForRet;
			}
			
			// Get the key name
			$MyKey = "";
			while (true) {
				$Zeichen = fread($vFile,1);
				if ($Zeichen == "\0")
					break;
				else 
					$MyKey .= $Zeichen;
			}
			// Remove slashes
			$MyKey = stripslashes($MyKey);
			
			// Is it a sub-array ?
			if (NextMatches($vFile,"\0{")) {
				// It is a subarray ^^
				$ForRet[$MyKey] = LoadArrayFromFile($vFile);
				// Skip the delemitter
				fread($vFile,1);
			} else {
				// Read the value
				$MyVal = "";
				while (true) {
					$Zeichen = fread($vFile,1);
					if ($Zeichen == "\0")
						break;
					else 
						$MyVal .= $Zeichen;
				}
				// Parse the value into the array
				$MyVal = stripslashes($MyVal);
				$ForRet[$MyKey] = $MyVal;
			}
		
		// Continue
		}
	}
	
	// Check if $Text is @ cursor position in $vFile
	// Syntax: NextMatches($vFile, $Text);
	function NextMatches($vFile, $Text)
	{
		// Save the current position in the file
		$PrevPos = ftell($vFile);
		
		// How long is $Text ?
		$Jump = strlen($Text);
		
		// Check if the file is long enaugh
		$stats = fstat($vFile);
		if (ftell($vFile) + $Jump > $stats[7])
			return false;
		
		// Read out a string as long as $Text
		$Erg = fread($vFile,$Jump);
		
		// Continue to the previous position.
		// I don't use whence for compatibility with PHP < 4
		fseek($vFile, $PrevPos);
		
		return ($Erg == $Text);
	}
	
	/*
	
	An example:
	
	Create an recursive array and save it. Reload it again and give it out.
	
	----------------
	*/
	
	$MyGuestbook = array();
	$MyGuestbook[1]['Name'] = "Test 1";
	$MyGuestbook[1]['Test'][1][1] = "Test 1.2.1";
	$MyGuestbook[1]['Test'][2] = "Test 1.3";
	$MyGuestbook[2]['Name'] = "Test 4";
	$MyGuestbook[3]['Test'] = "Test 5";
	$MyGuestbook[4] = "\0";	
	
	for ($i=0; $i<15; $i++)
		$MyGuestbook['Subarray']['Verybig'][$i] = strval($i);
		
	$Datei = fopen("Test.txt","wb");
	SaveArrayToFile($Datei, $MyGuestbook);
	fclose($Datei);
	
	$Datei = fopen("Test.txt","rb");
	$My = LoadArrayFromFile($Datei);
		
	
	
	echo($My[1]['Name']."<br>");
	echo($My[1]['Test'][1][1]."<br>");
	echo($My[1]['Test'][2]."<br>");
	echo($My[2]['Name']."<br>");
	echo($My[3]['Test']."<br>");
	echo("6:: ".$My['Subarray']['Verybig'][6]."<br>");
	echo($MyGuestbook[4]=="\0" ? "The last value is chr(0)" : "Sorry, my fault");
	
	fclose($Datei);
	unlink("Test.txt");
	
	/*
	---------------------
	
	*/
?>
/* Author: Joel Thoms
 * Website: http://www.joel.net
 * Email: (contact me through website)
 * Date: 02.05.2003
 * 
 * Copyright 2003 Joel Thoms
 *
 * Description:
 *	HtmlError generates an HTML error message from the generated Exception. HtmlError also includes 
 *	a routine to email the error message to the admin(s).
 * 
 *	This object can be used to capture individual errors, though it's best use is to globally capture
 *	errors using Global.asax. Both examples are provided.
 * 
 * 
 * Usage and Examples:
 * 
 *	Here is an example on how to capture a simple division by zero error.
 * 
 *	[C#]
 *		// Division by zero error example
 *		try {
 *			int x = 0;
 *			x = 1 / x;
 *		} catch (Exception Ex) {
 *			// Display Error Message to the browser
 *			Response.Write(HtmlError.getHtmlError(Ex));
 * 
 *			// Don't Specify SMTP Server
 *			HtmlError.sendHtmlError(Ex, "YOUR-EMAIL@ADDRESS.COM");
 * 
 *			// Specify SMTP Server
 *			//HtmlError.sendHtmlError(Ex, "YOUR-EMAIL@ADDRESS.COM", "your.smtp-server.com");
 *		}
 *
 * 
 * 	[VB.NET]
 *
 *		' Division by zero error example
 *		Try
 *			Dim x As Integer = 0
 *			x = 1 / x
 *		Catch Ex As Exception
 *			' Display Error Message to the browser
 *			Response.Write(HtmlError.getHtmlError(Ex))
 * 
 *			' Don't Specify SMTP Server
 *			HtmlError.sendHtmlError(Ex, "YOUR-EMAIL@ADDRESS.COM")
 * 
 *			' Specify SMTP Server
 *			'HtmlError.sendHtmlError(Ex, "YOUR-EMAIL@ADDRESS.COM", "your.smtp-server.com")
 *		End Try
 * 
 * 
 *	Here is an example on globally capturing errors using the Global.asax file.
 * 
 *	[C#]
 * 
 * 		protected void Application_Error(Object sender, EventArgs e) {
 *			// Don't Specify SMTP Server
 *			HtmlError.sendHtmlError(Context.Error.GetBaseException(), "YOUR-EMAIL@ADDRESS.COM");
 * 
 *			// Specify SMTP Server
 *			//HtmlError.sendHtmlError(Context.Error.GetBaseException(), "YOUR-EMAIL@ADDRESS.COM", "your.smtp-server.com");
 * 
 *			// Redirect User to Friendly Error Page
 *			Response.Redirect("/error.aspx");
 *		}
 * 
 *	[VB.NET]
 *		Sub Application_Error(ByVal sender As Object, ByVal e As EventArgs)
 *			' Don't Specify SMTP Server
 *			HtmlError.sendHtmlError(Context.Error.GetBaseException(), "YOUR-EMAIL@ADDRESS.COM")
 * 
 *			' Specify SMTP Server
 *			'HtmlError.sendHtmlError(Context.Error.GetBaseException(), "YOUR-EMAIL@ADDRESS.COM", "your.smtp-server.com")
 * 
 *			' Redirect User to Friendly Error Page
 *			Response.Redirect("/error.aspx")
 *		End Sub
 * 
 *
*/

using System;
using System.Data;
using System.Web;
using System.Web.Mail;
using System.Collections.Specialized;
/// <summary>HtmlError Object.</summary>
public class HtmlError {
	public HtmlError() { }
	static public void sendHtmlError(Exception Ex, string email_address) { sendHtmlError(Ex, email_address, ""); }
	static public void sendHtmlError(Exception Ex, string email_address, string smtp_server) {
		MailMessage mail = new MailMessage();
		mail.From = "server-errors@discountasp.net";
		mail.To = email_address;
		mail.Subject = "Uncaptured Error";
		mail.Body = getHtmlError(Ex);
		mail.BodyFormat = MailFormat.Html;
		if (smtp_server.Length > 0) SmtpMail.SmtpServer = smtp_server;
		SmtpMail.Send(mail);
	}
	/// <summary>Returns HTML an formatted error message.</summary>
	static public string getHtmlError(Exception Ex) {
		// Heading Template
		const string heading = "<TABLE BORDER=\"0\" WIDTH=\"100%\" CELLPADDING=\"1\" CELLSPACING=\"0\"><TR><TD bgcolor=\"black\" COLSPAN=\"2\"><FONT face=\"Arial\" color=\"white\"><B>&nbsp;<!--HEADER--></B></FONT></TD></TR></TABLE>";
		// Error Message Header
		string html = "<FONT face=\"Arial\" size=\"5\" color=\"red\">Error - " + Ex.Message + "</FONT><BR><BR>";
		// Populate Error Information Collection
		NameValueCollection error_info = new NameValueCollection();
		error_info.Add("Message", cleanHTML(Ex.Message));
		error_info.Add("Source", cleanHTML(Ex.Source));
		error_info.Add("TargetSite", cleanHTML(Ex.TargetSite.ToString()));
		error_info.Add("StackTrace", cleanHTML(Ex.StackTrace));
		// Error Information
		html += heading.Replace("<!--HEADER-->", "Error Information");
		html += CollectionToHtmlTable(error_info);
		// QueryString Collection
		html += "<BR><BR>" + heading.Replace("<!--HEADER-->", "QueryString Collection");
		html += CollectionToHtmlTable(HttpContext.Current.Request.QueryString);
		
		// Form Collection
		html += "<BR><BR>" + heading.Replace("<!--HEADER-->", "Form Collection");
		html += CollectionToHtmlTable(HttpContext.Current.Request.Form);
		// Cookies Collection
		html += "<BR><BR>" + heading.Replace("<!--HEADER-->", "Cookies Collection");
		html += CollectionToHtmlTable(HttpContext.Current.Request.Cookies);
		// Session Variables
		html += "<BR><BR>" + heading.Replace("<!--HEADER-->", "Session Variables");
		html += CollectionToHtmlTable(HttpContext.Current.Session);
		// Server Variables
		html += "<BR><BR>" + heading.Replace("<!--HEADER-->", "Server Variables");
		html += CollectionToHtmlTable(HttpContext.Current.Request.ServerVariables);
		return html;
	}
	static private string CollectionToHtmlTable(NameValueCollection collection) {
		// <TD>...</TD> Template
		const string TD = "<TD><FONT face=\"Arial\" size=\"2\"><!--VALUE--></FONT></TD>";
		// Table Header
		string html = "\n<TABLE width=\"100%\">\n"
			+ " <TR bgcolor=\"#C0C0C0\">" + TD.Replace("<!--VALUE-->", "&nbsp;<B>Name</B>")
			+ " " + TD.Replace("<!--VALUE-->", "&nbsp;<B>Value</B>") + "</TR>\n";
		// No Body? -> N/A
		if (collection.Count == 0) {
			collection = new NameValueCollection();
			collection.Add("N/A", "");
		}
		// Table Body
		for (int i = 0; i < collection.Count; i++) {
			html += "<TR valign=\"top\" bgcolor=\"" + ((i % 2 == 0) ? "white" : "#EEEEEE") + "\">"
				+ TD.Replace("<!--VALUE-->", collection.Keys[i]) + "\n"
				+ TD.Replace("<!--VALUE-->", collection[i]) + "</TR>\n";
		}
		// Table Footer
		return html + "</TABLE>";
	}
	static private string CollectionToHtmlTable(HttpCookieCollection collection) {
		// Overload for HttpCookieCollection collection.
		// Converts HttpCookieCollection to NameValueCollection
		NameValueCollection NVC = new NameValueCollection();
		foreach (string item in collection) NVC.Add(item, collection[item].Value);
		return CollectionToHtmlTable(NVC);
	}
	static private string CollectionToHtmlTable(System.Web.SessionState.HttpSessionState collection) {
		// Overload for HttpSessionState collection.
		// Converts HttpSessionState to NameValueCollection
		NameValueCollection NVC = new NameValueCollection();
		foreach (string item in collection) NVC.Add(item, collection[item].ToString());
		return CollectionToHtmlTable(NVC);
	}
	static private string cleanHTML(string Html) {
		// Cleans the string for HTML friendly display
		return (Html.Length == 0) ? "" : Html.Replace("<", "&lt;").Replace("\r\n", "<BR>").Replace("&", "&amp;").Replace(" ", "&nbsp;");
	}
}