VB icon

Ellis verson of Jasosnīs apid.pas

Email
Submitted on: 1/1/2015 3:48:00 PM
By: Erik Ellis (from psc cd)  
Level: Intermediate
User Rating: By 3 Users
Compatibility: Delphi 7, Delphi 6, Delphi 5
Views: 2445
 
     ist a colection of jasonīs apis and some more added by me =)
 
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
!**************************************
! for :Ellis verson of Jasosnīs apid.pas
!**************************************
Well... jason is the auther of this pas file so most of the credits are going to him
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
				
!**************************************
! Name: Ellis verson of Jasosnīs apid.pas
! Description:ist a colection of jasonīs apis and some more added by me =)
! By: Erik Ellis (from psc cd)
!
! Returns:all sorts of stuff
!
! Assumes:Just add the pas to ur project and add apis.pas dir to ur envirement for extra help and add apis to uses... like apis.<command>();....... copy the code and past it in a unit named apis.pas
!**************************************

{
 * 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.


Other 1 submission(s) by this author

 


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this code (in the Intermediate category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments


 There are no comments on this submission.
 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)
 

To post feedback, first please login.