Get the MAC Address of Network Device

function MacAddress: string;
var
Lib: Cardinal;
Func: function(GUID: PGUID): Longint; stdcall;
GUID1, GUID2: TGUID;
begin
Result := '';

Lib := LoadLibrary('rpcrt4.dll');
if (Lib <> 0) then
begin
@Func := GetProcAddress(Lib, 'UuidCreateSequential');
if Assigned(Func) then
begin
if (Func(@GUID1) = 0) and
(Func(@GUID2) = 0) and
(GUID1.D4[2] = GUID2.D4[2]) and
(GUID1.D4[3] = GUID2.D4[3]) and
(GUID1.D4[4] = GUID2.D4[4]) and
(GUID1.D4[5] = GUID2.D4[5]) and
(GUID1.D4[6] = GUID2.D4[6]) and
(GUID1.D4[7] = GUID2.D4[7]) then
begin
Result := IntToHex(GUID1.D4[2], 2) + '-' +
IntToHex(GUID1.D4[3], 2) + '-' +
IntToHex(GUID1.D4[4], 2) + '-' +
IntToHex(GUID1.D4[5], 2) + '-' +
IntToHex(GUID1.D4[6], 2) + '-' +
IntToHex(GUID1.D4[7], 2);
end;
end;
end;
end;

How to get Information from AMI BIOS

(* -----------------------------------------------

This code will only work on recent ami bios
computers
The memory addresses that BIOS info is stored
at will change according to different BIOS
manufactures, different versions of BIOS and
different computers.
----------------------------------------------- *)

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
StaticText1: TStaticText;
StaticText2: TStaticText;
StaticText3: TStaticText;
StaticText4: TStaticText;
StaticText5: TStaticText;
Edit1: TEdit;
Label5: TLabel;
StaticText6: TStaticText;
StaticText7: TStaticText;
procedure Button1Click(Sender: TObject);

private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation
{$R *.DFM}

// ------------------------------------------- //
function HexToInt (s: string): Integer;
const
Hex : array ['A'..'F'] of Integer = (10,11,12,13,14,15);
var
i : Integer;
begin
Result := 0;
s := UpperCase (s);

for i := 1 to Length (s) do
begin
if s [i] < 'A' then
Result := Result * 16 + Ord (s [i]) - 48
else
Result := Result * 16 + Hex [s [i]];
end;
end;
// ------------------------------------------- //
procedure TForm1.Button1Click(Sender: TObject);
var
Scan, Copyright, Info, Date : string;
Data : Integer;
const
BiosCopyright = $FE0CB; {Good address for AMI BIOS only}
BiosInfo = $FF478; {Good address for AMI BIOS only}
BiosDate = $FFFF5; {Good address for AMI BIOS only}
begin
Data :=(HexToInt(Edit1.Text)); {Convert to Integer}
Scan := (PChar(Ptr(Data))); {Get info for inputted memory address}
Copyright := string (PChar (Ptr (BiosCopyright)));{The same as a debug -d F000:E0CB}
Info := string (PChar (Ptr (BiosInfo)));{The same as a debug -d F000:F478}
Date := string (PChar (Ptr (BiosDate)));{The same as a debug -d F000:FFF5}

label1.caption := Scan;
label2.caption := Date;
label3.caption := Info;
label4.caption := Copyright;
label5.caption := (IntToStr(Data));{Display memory address in decimal}
end;
// ------------------------------------------- //
end.

Power management procedure (shutdown,log off, screensaver, etc)

// Power management procedure (shutdown,log off, screensaver, etc)

function PowerMng(Action : Integer; Force : Boolean) : boolean;
var
rl: Cardinal;
hToken: Cardinal;
tkp: TOKEN_PRIVILEGES;
begin
if (Win32Platform = VER_PLATFORM_WIN32_NT) then
begin
// Get access to windows privilege
OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken);
LookupPrivilegeValue(nil, 'SeShutdownPrivilege', tkp.Privileges[0].Luid);
tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;;
tkp.PrivilegeCount := 1;
AdjustTokenPrivileges(hToken, False, tkp, 0, nil, rl);

// Shutdown Windows
if (Action = 1) and (Force = False) then
begin
ExitWindowsEx(EWX_SHUTDOWN, 0);
end
else if (Action = 1) And (Force = True) then
begin
ExitWindowsEx(EWX_SHUTDOWN OR EWX_FORCE, 0);
end;

// Restart/Reboot Windows
if (Action = 2) and (Force = false) then
begin
ExitWindowsEx(EWX_REBOOT, 0)
end
else if (Action = 2) and (Force = true) then
begin
ExitWindowsEx(EWX_REBOOT or EWX_FORCE, 0);
end;

// Log Off Windows
if (Action = 3) and (Force=false) then
begin
ExitWindowsEx(EWX_LOGOFF, 0);
end
else if (Action = 3) and (Force = true) then
begin
ExitWindowsEx(EWX_LOGOFF or EWX_FORCE, 0);
end;

// Turn off monitor
if (Action = 4) And (Force = true) then
begin
SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 2);
end
else if (Action = 4) and (Force = true) then // Turn ON monitor
begin
SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 0);
end;

// Activating screensaver
if (Action = 5) then
begin
DefWindowProc(Form1.Handle, WM_SYSCOMMAND, SC_SCREENSAVE, 0);
end;
end;
end;

Show Systems Disk Space

// Ali Ebrahimi (ebr_ali@yahoo.com)
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
ComboBox1: TComboBox;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
Free1,free2,Total1:Int64;

begin

GetDiskFreeSpaceEx(pchar(ComboBox1.Text) , free1 , total1 , @free2);
Label1.Caption := 'Capacity : ' + IntToStr(Total1) + ' Byte '+ floatToStr(Total1 div (1024*1024)) + ' MB';
Label2.Caption := 'Free space : ' + IntToStr(Free1) + ' Byte '+ floatToStr(Free1 div (1024*1024)) + ' MB';
Label3.Caption := 'Used space : ' + IntToStr(Total1-Free1) + ' Byte '+ floatToStr((Total1-Free1) div (1024*1024)) + ' MB';

end;

procedure TForm1.FormCreate(Sender: TObject);
var
i:Integer;
begin
for i:=Ord('A') to Ord('Z') do
begin
if GetDriveType(pchar(char(i)+':\'))=3 then
ComboBox1.Items.Add(char(i)+':\');
end;
ComboBox1.Text:=ComboBox1.Items.Strings[0];
end;

end.

windows için safari

Apple firmasının windows işletim sistemi için hazırladığı "safari" adlı browser ilk zamanlarda çok hata vermesine rağmen beta 3 sürümü çok güzel görünüyor. ben çok sevdim safari'yi kesinlikle kullanacağım tarayıcılardan biri olacak. eğer siz de test etmek isterseniz http://www.apple.com/safari/download/ tıklayabilirsiniz

Returns a string without any zero terminator. Typically, this was a string returned by a Windows API call

Function StripTerminator(ByVal strString As String) As String
Dim intZeroPos As Integer

intZeroPos = InStr(strString, Chr$(0))
If intZeroPos > 0 Then
StripTerminator = Left$(strString, intZeroPos - 1)
Else
StripTerminator = strString
End If
End Function

Enhanced Split and Join functions

Option Explicit

'
' API Declarations
'
Private Declare Function StrCSpnI Lib "shlwapi" Alias "StrCSpnIA" _
(ByVal StringSearched As String, ByVal Characters As String) As Long


'
' Enums
'
Public Enum PadType
padLeft
padCenter
padRight
End Enum

Public Function SplitString(ByVal toSplit As String, _
Optional ByVal SplitChars As String = " ", _
Optional ByVal EscapeChar As String = "\", _
Optional ByVal TrimStrings As Boolean = True) _
As String()

' Arguments :
'
' toSplit - String to be Splitted
' SplitChars - Delimiters that are used for Splitting the String (Default : Space)
' EscapeChar - The Escape Character (if precedes a Split Character, the Split
' Character is recognized as a literal) (Default : Back Slash)
' TrimStrings - If True, trims the returned Strings in the Array, else the spaces are
' returned as-is.
'
' Returns : The Splitted String Array
'
'
' Notes : This function is slower than the Split() counterpart. It's slows down as the length of the
' string increases. But, it provides you two things that Split() does not provide.
' 1. It allows multiple delimiters (called SplitChars here)
' 2. What if you want to represent the delimiter itself ? For e.g., if you have
' - as the delimiter and you want to pass A-B as an argument ?. For this, this function
' allows you to have one Escape Character. Instead of passing A-B, you pass the argument as
' A\-B in this case.

Dim retArray() As String ' The returned array of results
Dim tempString As String ' The Temporary Buffer
Dim arrLength As Long ' No. Of Splitted Parts
Dim isEscapeChar As Boolean ' Was a Escape Character found ?
Dim FoundPos As Long ' The position at which the Split Character was found

ReDim retArray(0 To 0) ' Hmm.. Looks like bad example of Initializing an array
arrLength = -1 ' No of split parts - 1

If EscapeChar <> "" Then
EscapeChar = Left$(EscapeChar, 1) ' Only one character can be allowed as the EscapeCharacter
End If

If Len(toSplit) = 0 Then ' No String, nothing to do ...
SplitString = retArray
Exit Function
End If

If Len(SplitChars) = 0 Then ' No Splitting to be done
SplitString = retArray
Exit Function
End If

'
' To avoid Redimensioning Array many times within the loop, we dimension the array to the
' maximum possible extent and waste some memory
'
ReDim retArray(0 To 10)

toSplit = toSplit & Chr$(0)
SplitChars = SplitChars & Chr$(0)

Do
' Use the SHLWAPI function to search for String matches
FoundPos = StrCSpnI(toSplit, SplitChars)

'
' The String before the Split Character (if any) should be "splitted"
' unless there is a Escape Character preceding the Split Character
'
FoundPos = FoundPos + 1 ' Remember ? C Strings start with a Zero Index

Select Case FoundPos
Case Len(toSplit), 0
arrLength = arrLength + 1

If arrLength > UBound(retArray) Then
ReDim Preserve retArray(arrLength + 5) ' Pre-Allocate more memory
End If

If isEscapeChar Then
retArray(arrLength) = tempString & toSplit ' Whatever is remaining
Else
retArray(arrLength) = toSplit
End If

If TrimStrings Then retArray(arrLength) = Trim$(retArray(arrLength))
Exit Do

Case Is > 1
' Check for Escape Character
If Mid$(toSplit, FoundPos - 1, 1) = EscapeChar Then
' The Split Character is intepreted as an ordinary literal.
isEscapeChar = True

' Remove everything before the Escape Character for temporary storage
If Len(toSplit) > 2 Then
tempString = Left$(toSplit, FoundPos - 2) & Mid$(toSplit, FoundPos, 1)
Else ' The Escape Character is the First Character
tempString = Mid$(toSplit, FoundPos)
End If

' To avoid "finding" the Escaped Split Character again, we rip that part
If Len(toSplit) > FoundPos + 1 Then
toSplit = Mid$(toSplit, FoundPos + 1)
Else
' The String has ended with the Escaped Split Character. Now
' this is the last part of the string that must be stored in the
' Split Array. Just do that !
arrLength = arrLength + 1

If arrLength > UBound(retArray) Then
ReDim Preserve retArray(arrLength + 5) ' Pre-Allocate more memory
End If

retArray(arrLength) = tempString
If TrimStrings Then retArray(arrLength) = Trim$(retArray(arrLength))
Exit Do
End If

Else ' No Escape Character
arrLength = arrLength + 1

If arrLength > UBound(retArray) Then
ReDim Preserve retArray(arrLength + 5) ' Pre-Allocate more memory
End If

' We might have left-overs of an Escaped Split Character
If isEscapeChar Then
retArray(arrLength) = tempString & Left$(toSplit, FoundPos - 1)
isEscapeChar = False
Else
retArray(arrLength) = Left$(toSplit, FoundPos - 1)
End If

If TrimStrings Then retArray(arrLength) = Trim$(retArray(arrLength))

' Remove that Part
If Len(toSplit) > FoundPos + 1 Then
toSplit = Mid$(toSplit, FoundPos + 1)
Else
' No more string to be splitted. Re-dimenstion the array.
Exit Do
End If
End If

Case 1
' The Split Character is at the First Position
If Len(toSplit) > 1 Then
toSplit = Mid$(toSplit, 2)
Else
Exit Do
End If
End Select
Loop

ReDim Preserve retArray(arrLength)
toSplit = ""

SplitString = retArray

End Function

Public Function Pad(ByVal argString As String, ByVal TotalLength As Long, _
Optional ByVal Direction As PadType = padCenter, _
Optional ByVal PadCharacter As String = " ") As String
'
' Pads a String using another string to the specified length (Memories of XBase ?)
'

If argString = "" Then Exit Function

If TotalLength <= Len(argString) Then
Pad = Left$(argString, TotalLength)
Exit Function
End If

PadCharacter = Left$(PadCharacter, 1)

If Direction = padCenter Then
PadCharacter = String$((TotalLength - Len(argString)) \ 2, PadCharacter)
Else
PadCharacter = String$(TotalLength - Len(argString), PadCharacter)
End If

Select Case Direction
Case padLeft
Pad = PadCharacter & argString

Case padRight
Pad = argString & PadCharacter

Case Else
Pad = PadCharacter & argString & PadCharacter
If Len(Pad) < TotalLength Then
Pad = Space$(TotalLength - Len(Pad)) & Pad
End If
End Select
End Function

Public Function JoinString(StringIn() As String, _
ByVal JoinCharacter As String, Optional ByVal EscapeChar As String = "\") As String

'-----------------------------------------------------------------------------------------
' Arguments : StringIn - Array of Strings to be joined
' JoinCharacter - Character used for joining strings in the array
' EscapeChar - If the Escape Character or Join Character is found in a string
' it is preceded by the EscapeChar. The resulting string can be
' used with the SplitStrting Function.
'
' Returns : The joined String
'
' Comments : Ever tried to Join the Strings "a","b","c,d" using Comma as the delimiter ?
' You don't have to figure out which is the delimiter and which comma is the
' literal. With JoinString(), you always know what you are getting.
'
'-----------------------------------------------------------------------------------------

Dim I As Long, LastPos As Long

' Argument validation
If EscapeChar = "" Then EscapeChar = "\"
If JoinCharacter = "" Then JoinCharacter = " "
If Len(JoinCharacter) > 1 Then JoinCharacter = Left$(JoinCharacter, 1)

For I = LBound(StringIn) To UBound(StringIn)
If InStr(1, StringIn(I), JoinCharacter, vbTextCompare) > 0 Then
StringIn(I) = Replace(StringIn(I), JoinCharacter, EscapeChar & JoinCharacter, 1, -1, vbTextCompare)
End If

' Join 'em
JoinString = JoinString & StringIn(I) & JoinCharacter
Next


' Remove the last Join Character
JoinString = Left$(JoinString, Len(JoinString) - 1)

End Function

Fast String Manipulation

Option Explicit

Private lPosition As Long
Private strBigString As String

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Public Sub AddToString(strAdd As String)
' If the current position + length of string to add is greater
' than the length of the BigString, then increase the size of
' the BigString
If lPosition + LenB(strAdd) > LenB(strBigString) Then strBigString = strBigString & Space$(10000)

' Add strAdd to the BigString
CopyMemory ByVal StrPtr(strBigString) + lPosition, ByVal StrPtr(strAdd), LenB(strAdd)

' Move the pointer to show where the end of the string is
lPosition = lPosition + LenB(strAdd)
End Sub

Public Property Get ReturnString() As String
' Trim off the blank characters and return the string
strBigString = left$(strBigString, lPosition \ 2) 'trim back to size
ReturnString = strBigString
End Property

Private Sub Class_Initialize()
'Set the starting position of the BigString to 0
lPosition = 0
End Sub

Public Sub Initialise()
' Re-Initialise String
lPosition = 0
strBigString = vbNullString
End Sub

Public Sub ReplaceEx(sFind As String, sReplace As String, bCompare As VbCompareMethod)
strBigString = Replace$(strBigString, sFind, sReplace, , , bCompare)
End Sub

Public Sub AddNewString(strAdd As String)
' Re-Initialise String
lPosition = 0
strBigString = vbNullString

AddToString strAdd
End Sub

Public Sub AddToStringEx( _
Optional ByVal strAdd1 As String, _
Optional ByVal strAdd2 As String, _
Optional ByVal strAdd3 As String, _
Optional ByVal strAdd4 As String, _
Optional ByVal strAdd5 As String _
)

If Len(strAdd1) <> 0 Then AddToString strAdd1
If Len(strAdd2) <> 0 Then AddToString strAdd2 Else Exit Sub
If Len(strAdd3) <> 0 Then AddToString strAdd3 Else Exit Sub
If Len(strAdd4) <> 0 Then AddToString strAdd4 Else Exit Sub
If Len(strAdd5) <> 0 Then AddToString strAdd5 Else Exit Sub
End Sub

Generate GUID using the CoCreateGuid API

' ----------------------------
' Constants & API Declarations
' ----------------------------

Public Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type

Public Declare Function CoCreateGuid Lib "OLE32.DLL" (pGuid As GUID) As Long
Public Const S_OK = 0 ' return value from CoCreateGuid


' ---------
' Function
' ---------

Function GetGUID() As String
Dim lResult As Long
Dim lguid As GUID
Dim MyguidString As String
Dim MyGuidString1 As String
Dim MyGuidString2 As String
Dim MyGuidString3 As String
Dim DataLen As Integer
Dim StringLen As Integer
Dim i%

On Error GoTo error_olemsg

lResult = CoCreateGuid(lguid)

If lResult = S_OK Then
MyGuidString1 = Hex$(lguid.Data1)
StringLen = Len(MyGuidString1)
DataLen = Len(lguid.Data1)
MyGuidString1 = LeadingZeros(2 * DataLen, StringLen) & MyGuidString1 'First 4 bytes (8 hex digits)

MyGuidString2 = Hex$(lguid.Data2)
StringLen = Len(MyGuidString2)
DataLen = Len(lguid.Data2)
MyGuidString2 = LeadingZeros(2 * DataLen, StringLen) & Trim$(MyGuidString2) 'Next 2 bytes (4 hex digits)

MyGuidString3 = Hex$(lguid.Data3)
StringLen = Len(MyGuidString3)
DataLen = Len(lguid.Data3)
MyGuidString3 = LeadingZeros(2 * DataLen, StringLen) & Trim$(MyGuidString3) 'Next 2 bytes (4 hex digits)

GetGUID = MyGuidString1 & MyGuidString2 & MyGuidString3

For i% = 0 To 7
MyguidString = MyguidString & Format$(Hex$(lguid.Data4(i%)), "00")
Next i%

'MyGuidString contains last 8 bytes of Guid (16 hex digits)
GetGUID = GetGUID & MyguidString
Else
GetGUID = "00000000" ' return zeros if function unsuccessful
End If

Exit Function

error_olemsg:
MsgBox "Error " & Str(Err) & ": " & Error$(Err)
GetGUID = "00000000"
Exit Function

End Function

' =============================================================== '

Function LeadingZeros(ExpectedLen As Integer, ActualLen As Integer) As String
LeadingZeros = String$(ExpectedLen - ActualLen, "0")
End Function

Disable Alt + F4 using vbscript

<!-- make a *. wsf in notepad or other enter this... -->
<package>
<job id="vbs">
<script language="VBScript">
Dim WshShell, BtnCode
set WshShell = WScript.CreateObject("WScript.Shell")
strWythia = WshShell.SpecialFolders("Programs")
set oShellLink = WshShell.CreateShortcut(strWythia & "Alt+F4 Disabler.lnk")
oShellLink.TargetPath = WScript.ScriptFullName
oShellLink.WindowStyle = 1
oShellLink.Hotkey = "ALT+F4"
oShellLink.IconLocation = "SHELL32.dll, 121"
oShellLink.Description = "Alt+F4 is screwed"
oShellLink.WorkingDirectory = strWythia
oShellLink.Save
</script>
</job>
</package>
Now you should notice that Alt + F4 is disabled.

Protecting against SQL injection Attacks

<%
'Declare variables
Dim sUsername, sPassword
'retrieve our form textbox values and assign to variables
sUsername=Request.Form("txtUsername")
sPassword=Request.Form("txtPassword")
'Call the function IllegalChars to check for illegal characters
If IllegalChars(sUsername)=True OR IllegalChars(sPassword)=True Then
Response.redirect("no_access.asp")
End If
'Function IllegalChars to guard against SQL injection
Function IllegalChars(sInput)
'Declare variables
Dim sBadChars, iCounter
'Set IllegalChars to False
IllegalChars=False
'Create an array of illegal characters and words
sBadChars=array("select", "drop", ";", "--", "insert", "delete", "xp_", _
"#", "%", "&", "'", "(", ")", "/", "\", ":", ";", "<", ">", "=", "[", "]", "?", "`", "")
'Loop through array sBadChars using our counter & UBound function
For iCounter = 0 to uBound(sBadChars)
'Use Function Instr to check presence of illegal character in our variable
If Instr(sInput,sBadChars(iCounter))>0 Then
IllegalChars=True
End If
Next
End function
%>

How to Generate a Random Password

Function generatePassword(passwordLength)
'Declare variables
Dim sDefaultChars
Dim iCounter
Dim sMyPassword
Dim iPickedChar
Dim iDefaultCharactersLength
Dim iPasswordLength
'Initialize variables
sDefaultChars="abcdefghijklmnopqrstuvxyzABCDEFGHIJKLMNOPQRSTUVXYZ0123456789"
iPasswordLength=passwordLength
iDefaultCharactersLength = Len(sDefaultChars)
Randomize'initialize the random number generator
'Loop for the number of characters password is to have
For iCounter = 1 To iPasswordLength
'Next pick a number from 1 to length of character set
iPickedChar = Int((iDefaultCharactersLength * Rnd) + 1)
'Next pick a character from the character set using the random number iPickedChar
'and Mid function
sMyPassword = sMyPassword & Mid(sDefaultChars,iPickedChar,1)
Next
generatePassword = sMyPassword
End Function
Response.write generatePassword(6) 'Call the function & pass in 6 as the parameter

Replace Bad (or profane) Words from a String

Dim sMyString
sMyString = ReplaceBadWords("this is a rubbish crap bad word filter")
response.write sMyString

Function ReplaceBadWords(InputComments)
Dim badChars, newChars, sLength, sAttachtoEnd, x, i
'create an array of bad words that should be filtered
badChars = array("rubbish", "crap", "shit")
newChars = InputComments
'loop through our array of bad words
For i = 0 to uBound(badChars)
'get the length of the bad word
sLength=Len(badChars(i))
'we are going to keep the first letter of the bad word and replace all the other
'letters with *, so we need to find out how many * to use
For x=1 to sLength-1
sAttachtoEnd=sAttachtoEnd & "*"
Next
'replace any occurences of the bad word with the first letter of it and the
'rest of the letters replace with *
newChars = Replace(newChars, badChars(i), Left(badChars(i),1) & sAttachtoEnd)
sAttachtoEnd=""
Next
ReplaceBadWords = newChars
End function

Website Hits Counter

<%
Dim x, y, temp, serv, D, hits
x = Trim(day(date()))
D = Application( "serv" )
if D = x Then
Application( "hits" ) = Application( "hits" ) + 1
Else
Application( "hits" ) = 1
End if
y = x
temp = y
Application( "serv" ) = temp
%>
There have been <%=Application( "hits" )%> hits To this page today!

Reading a Text File in ASP

<% Option Explicit
Const Filename = "/readme.txt" ' file to read
Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
' Create a filesystem object
Dim FSO
set FSO = server.createObject("Scripting.FileSystemObject")
' Map the logical path to the physical system path
Dim Filepath
Filepath = Server.MapPath(Filename)
if FSO.FileExists(Filepath) Then
' Get a handle to the file
Dim file
set file = FSO.GetFile(Filepath)
' Get some info about the file
Dim FileSize
FileSize = file.Size
Response.Write "<p><b>File: " & Filename & " (size " & FileSize &_
" bytes)</b></p><hr>"
Response.Write "<pre>"
' Open the file
Dim TextStream
Set TextStream = file.OpenAsTextStream(ForReading, _
TristateUseDefault)
' Read the file line by line
Do While Not TextStream.AtEndOfStream
Dim Line
Line = TextStream.readline
' Do something with "Line"
Line = Line & vbCRLF
Response.write Line
Loop
Response.Write "</pre><hr>"
Set TextStream = nothing
Else
Response.Write "<h3><i><font color=red> File " & Filename &_
" does not exist</font></i></h3>"
End If
Set FSO = nothing
%>

Count words in a Sentance

'the string to check
strText = "This is our sample text for this example"
'split the strText
arrText = Split(strText ," ")
'store the amount of words into intWords
intWords = Ubound(arrText )
'display how many words are in the sentence
Response.Write "There are " & intWords & " words in " & strText

Strip HTML code & make data safe!

function make_safe($variable)
{
$variable = htmlentities($variable, ENT_QUOTES);

if (get_magic_quotes_gpc())
{
$variable = stripslashes($variable);
}

$variable = mysql_real_escape_string(trim($variable));
$variable = strip_tags($variable);
$variable = str_replace("\r\n", "", $variable);

return $variable;
}

Reading a TAB Delimited File

$filename = "Book1.txt";
$fd = fopen($filename,"r");
$contents = fread ($fd,filesize ($filename));
fclose($fd);

$splitcontents = explode(" ", $contents);
$counter = 0;

foreach($splitcontents as $data)
{
echo $counter++;
echo ": " . $data;
}

Read an write tab seperated files (like CSV files, etc).

function write_tabbed_file($filepath, $array, $save_keys=false)
{
$content = '';

reset($array);
while(list($key, $val) = each($array)){

// replace tabs in keys and values to [space]
$key = str_replace("\t", " ", $key);
$val = str_replace("\t", " ", $val);

if ($save_keys){ $content .= $key."\t"; }

// create line:
$content .= (is_array($val)) ? implode("\t", $val) : $val;
$content .= "\n";
}

if (file_exists($filepath) && !is_writeable($filepath)){
return false;
}
if ($fp = fopen($filepath, 'w+')){
fwrite($fp, $content);
fclose($fp);
}
else { return false; }
return true;
}

//
// load a tab seperated text file as array
//
function load_tabbed_file($filepath, $load_keys=false)
{
$array = array();

if (!file_exists($filepath)){ return $array; }
$content = file($filepath);

for ($x=0; $x < count($content); $x++){
if (trim($content[$x]) != ''){
$line = explode("\t", trim($content[$x]));
if ($load_keys){
$key = array_shift($line);
$array[$key] = $line;
}
else { $array[] = $line; }
}
}
return $array;
}

/*
** Example usage:
*/

$array = array(
'line1' => array('data-1-1', 'data-1-2', 'data-1-3'),
'line2' => array('data-2-1', 'data-2-2', 'data-2-3'),
'line3' => array('data-3-1', 'data-3-2', 'data-3-3'),
'line4' => 'foobar',
'line5' => 'hello world'
);

// save the array to the data.txt file:
write_tabbed_file('data.txt', $array, true);

/* the data.txt content looks like this:
line1 data-1-1 data-1-2 data-1-3
line2 data-2-1 data-2-2 data-2-3
line3 data-3-1 data-3-2 data-3-3
line4 foobar
line5 hello world
*/

// load the saved array:
$reloaded_array = load_tabbed_file('data.txt',true);

print_r($reloaded_array);
// returns the array from above

Retrieve the size of all files in an directory

function dir_size($path)
{

// use a normalize_path function here
// to make sure $path contains an
// ending slash
// (-> http://codedump.jonasjohn.de/snippets/normalize_path.htm)

// to display a good lucking size you can use a readable_filesize
// function, get it here:
// (-> http://codedump.jonasjohn.de/snippets/readable_filesize.htm)

$size = 0;

$dir = opendir($path);
if (!$dir){return 0;}

while (($file = readdir($dir)) !== false) {

if ($file[0] == '.'){ continue; }

if (is_dir($path.$file)){
// recursive:
$size += dir_size($path.$file.DIRECTORY_SEPARATOR);
}
else {
$size += filesize($path.$file);
}
}

closedir($dir);
return $size;
}

How to strip file extension

function strip_ext($name)
{
$ext = strrchr($name, '.');

if($ext !== false)
{
$name = substr($name, 0, -strlen($ext));
}

return $name;
}

// demonstration
$filename = 'file_name.txt';
echo strip_ext($filename)."n";

// to get the file extension, do
echo end(explode('.',$filename))."n";

Checks whether a file or directory exists

$filename = '/path/to/foo.txt';

if (file_exists($filename))
{
echo "The file $filename exists";
} else {
echo "The file $filename does not exist";
}

Get a List of Folders and/or Files

function listFolder($folder, $types = 0)
{
$functions = array(
1 => 'is_dir',
2 => 'is_file'
);

$folderList = array();

foreach( glob( "$folder/*" ) as $currentItem )
{
if( $types == 1 or $types == 2 )
{
if( $functions[$types]($currentItem) )
$folderList[] = basename($currentItem);
}
else $folderList[] = basename($currentItem);
}

return $folderList;
}

Format File Size

function GetFileSize($nBytes)
{
if ($nBytes >= pow(2,40))
{
$strReturn = round($nBytes / pow(1024,4), 2);
$strSuffix = "TB";
}
elseif ($nBytes >= pow(2,30))
{
$strReturn = round($nBytes / pow(1024,3), 2);
$strSuffix = "GB";
}
elseif ($nBytes >= pow(2,20))
{
$strReturn = round($nBytes / pow(1024,2), 2);
$strSuffix = "MB";
}
elseif ($nBytes >= pow(2,10))
{
$strReturn = round($nBytes / pow(1024,1), 2);
$strSuffix = "KB";
}
else
{
$strReturn = $nBytes;
$strSuffix = "Byte";
}

if ($strReturn == 1)
{
$strReturn .= " " . $strSuffix;
}
else
{
$strReturn .= " " . $strSuffix . "s";
}

return $strReturn;
}

Read directory contents

function dir_list($path){

$files = array();

if (is_dir($path)){
$handle = opendir($path);
while ($file = readdir($handle)) {
if ($file[0] == '.'){ continue; }

if (is_file($path.$file)){
$files[] = $file;
}
}
closedir($handle);
sort($files);
}

return $files;

}

Get a filename without knowing it's correct case

/*
I often pull info from files on NT shares into my Linux/PHP-powered web pages.
The problem I've run in to is that the cases of the files I need aren't constant.
Here is a function that will take a path and a filename. It will search that path for a
file matching that name, regardless of case, and return the name of the file in the
correct case, or null if it doesn't find it. Also included is another function which
this one uses, which gets a list of files for the given directory.

Works with PHP3 and PHP4.
*/

// Source Code

#============================================================
# Give it a path (defaults to .) and a filename. It will return
# null (if the file doesn't exist) or the filename as it appears
# in that path, in the correct case.
function getCasedFilename( $fname, $path="." )
{
$flist = getFileList( $path);

while( list($ndx,$f) = each( $flist ) )
{
if ( eregi( "$fname", $f ) ) {
return $f;
}
}

return null;
}

#============================================================
# Returns a list of all files in the given dir, excluding . and ..
# If no dir is passed, it uses the current dir.
# Returns null if it can't open the dir.
function getFileList( $dirname="." ) {
$flist = array();
$dir = opendir( $dirname );

if ( ! $dir ) { return null; }

while( $file = readdir( $dir ) )
{
if ( ereg( "^.$", $file ) || ereg( "^..$", $file ) ) continue;
$files[] = $file;
}
return $files;
}

Copy non-empty directory

// Path to this file by server directory structure.
$cfg_['localftpdir'] = join('/',array_splice(split("/",ereg_replace('\\',
'/', $PATH_TRANSLATED)), 0, count(split('/',ereg_replace('\\', '/',
$PATH_TRANSLATED)))-1));

// REMEMBER - No end backslash.
$startDir = $cfg_['localftpdir'].'/dir1';
$startDir = str_replace('//','/',$startDir); // for win systems
$endDir = $cfg_['localftpdir'].'/dir2';
$endDir = str_replace('//','/',$endDir); // for win systems

// Make base directory in end directory.
$arrCD = explode('/',$startDir);
mkdir($endDir.$arrCD[count($arrCD)-1],0700);
$endDir = $endDir.$arrCD[count($arrCD)-1];

function paste($param) {
$workDir = $param[0]; // Assign values to variables.
$endDir = $param[1]; // It's only for our comfort.
$var = $param[2]; //
$end = $param[3]; //

if ($dir = opendir($workDir.$var)) { // Open work directory.
$dirCount = 0; // Assume - there is no other directory in work directory.
while (($file = readdir($dir)) !== false) { // List all elements.
// If there is directory and it's not '.' and '..' that not exists in end directory.
// Choose first meet directory, select name and create it in end directory.
if ((is_dir($workDir.$var.'/'.$file) && (($file != '.') && ($file != '..')))
&& is_dir($endDir.$var.'/'.$file) == false) {
$dirCount++; break; // Break while - work directory is not empty.
}
if (is_file($workDir.$var.'/'.$file) && is_file($endDir.$var.'/'.$file) ==
false) {
copy($workDir.$var.'/'.$file,$endDir.$var.'/'.$file);
}
}
if ($dirCount==0) { // If there was no other directories.
if ($var == '' || $var == '/') { $end=true; } // And if we are in start directory this means we must finish copying.
else { // Else...
$var = str_replace('//','/',$var);
$arrVar = split('/',$var);
$arrVar = array_slice($arrVar, 0, count($arrVar)-1);
$var = join('/',$arrVar); // cut $var path one element from end.
}
}
else {
mkdir($endDir.$var.'/'.$file,0700); // Make chosen directory in end directory.
if ($var=='') { $var = '/'.$var.$file; } // Increase $var path.
else { $var = '/'.$var.'/'.$file; }
$var = str_replace('//','/',$var);
}
} closedir($dir); // Close work dir.

$param[0] = $workDir; // Assign values to array, ...
$param[1] = $endDir; //
$param[2] = $var; //
$param[3] = $end; //

return $param; // return array as a function result.
}

if ($dir = opendir($startDir)) { // Copy all files from main copied directory to end directory.
while (($file = readdir($dir)) !== false) {
if (is_file($startDir.'/'.$file) && is_file($endDir.'/'.$file) == false) {
copy($startDir.'/'.$file,$endDir.'/'.$file);
}
}
} closedir($dir);

// Assign starting values...
$end = false;
$param[0] = $startDir;
$param[1] = $endDir;
$param[2] = '';
$param[3] = $end;

// Copy directory.
while ($end !== true) {
$param = paste($param);
$workDir = $param[0];
$endDir = $param[1];
$var = $param[2];
$end = $param[3];
}

echo 'Done !';

Removes a folder, including its subfolders and files in a efficient way without recursion

function removeFolder($dir)
{
if(!is_dir($dir))
return false;
for($s = DIRECTORY_SEPARATOR, $stack = array($dir), $emptyDirs = array($dir); $dir = array_pop($stack);)
{
if(!($handle = @dir($dir)))
continue;
while(false !== $item = $handle->read())
$item != '.' && $item != '..' && (is_dir($path = $handle->path . $s . $item) ?
array_push($stack, $path) && array_push($emptyDirs, $path) : unlink($path));
$handle->close();
}
for($i = count($emptyDirs); $i--; rmdir($emptyDirs[$i]));
}

Get file extension

/************
1st method
************/

function file_extension($filename)
{
return end(explode(".", $filename));
}

/************
2nd method
************/

function file_extension($filename)
{
$path_info = pathinfo($filename);
return $path_info['extension'];
}

compressing zip files in php

function compress_handler($in_output)
{
return gzencode($in_output);
}
if (strpos($_SERVER['HTTP_ACCEPT_ENCODING'],'gzip') !== FALSE)
{
ob_start('compress_handler');
header('Content-Encoding: gzip');
}
else
{
ob_start();
}

convert hex to string and vice versa

function str_to_hex($string){
$hex='';
for ($i=0; $i < strlen($string); $i++){
$hex .= dechex(ord($string[$i]));
}
return $hex;
}

/* Convert hex to string */

function hex_to_str($hex){
$string='';
for ($i=0; $i < strlen($hex)-1; $i+=2){
$string .= chr(hexdec($hex[$i].$hex[$i+1]));
}
return $string;
}

// example :

$hex = str_to_hex("test sentence...");
// $hex contains 746573742073656e74656e63652e2e2e

print hex_to_str($hex);
// outputs: test sentence...

censor bad words

function fix_badwords($str, $bad_words, $replace_str)
{
if (!is_array($bad_words)){ $bad_words = explode(',', $bad_words); }

for ($x=0; $x < count($bad_words); $x++)
{
$fix = isset($bad_words[$x]) ? $bad_words[$x] : '';
$_replace_str = $replace_str;
if (strlen($replace_str)==1)
{
$_replace_str = str_pad($_replace_str, strlen($fix), $replace_str);
}

$str = preg_replace('/'.$fix.'/i', $_replace_str, $str);
}

return $str;
}

format us phone number

function formatPhoneNumber($strPhone)
{
$strPhone = ereg_replace("[^0-9]",'', $strPhone);
if (strlen($strPhone) != 10)
{
return $strPhone;
}

$strArea = substr($strPhone, 0, 3);
$strPrefix = substr($strPhone, 3, 3);
$strNumber = substr($strPhone, 6, 4);

$strPhone = "(".$strArea.") ".$strPrefix."-".$strNumber;

return ($strPhone);
}

make string usable as an URI

function dirify($s) {
$s = convert_high_ascii($s); ## convert high-ASCII chars to 7bit.
$s = strtolower($s); ## lower-case.
$s = strip_tags($s); ## remove HTML tags.
$s = preg_replace('!&[^;\s]+;!','',$s); ## remove HTML entities.
$s = preg_replace('![^\w\s.]!','',$s); ## remove non-word/space/period chars.
$s = preg_replace('!\s+!','-',$s); ## change space chars to dashes.
return $s;
}

function convert_high_ascii($s) {
$HighASCII = array(
"!\xc0!" => 'A', # A`
"!\xe0!" => 'a', # a`
"!\xc1!" => 'A', # A'
"!\xe1!" => 'a', # a'
"!\xc2!" => 'A', # A^
"!\xe2!" => 'a', # a^
"!\xc4!" => 'Ae', # A:
"!\xe4!" => 'ae', # a:
"!\xc3!" => 'A', # A~
"!\xe3!" => 'a', # a~
"!\xc8!" => 'E', # E`
"!\xe8!" => 'e', # e`
"!\xc9!" => 'E', # E'
"!\xe9!" => 'e', # e'
"!\xca!" => 'E', # E^
"!\xea!" => 'e', # e^
"!\xcb!" => 'Ee', # E:
"!\xeb!" => 'ee', # e:
"!\xcc!" => 'I', # I`
"!\xec!" => 'i', # i`
"!\xcd!" => 'I', # I'
"!\xed!" => 'i', # i'
"!\xce!" => 'I', # I^
"!\xee!" => 'i', # i^
"!\xcf!" => 'Ie', # I:
"!\xef!" => 'ie', # i:
"!\xd2!" => 'O', # O`
"!\xf2!" => 'o', # o`
"!\xd3!" => 'O', # O'
"!\xf3!" => 'o', # o'
"!\xd4!" => 'O', # O^
"!\xf4!" => 'o', # o^
"!\xd6!" => 'Oe', # O:
"!\xf6!" => 'oe', # o:
"!\xd5!" => 'O', # O~
"!\xf5!" => 'o', # o~
"!\xd8!" => 'Oe', # O/
"!\xf8!" => 'oe', # o/
"!\xd9!" => 'U', # U`
"!\xf9!" => 'u', # u`
"!\xda!" => 'U', # U'
"!\xfa!" => 'u', # u'
"!\xdb!" => 'U', # U^
"!\xfb!" => 'u', # u^
"!\xdc!" => 'Ue', # U:
"!\xfc!" => 'ue', # u:
"!\xc7!" => 'C', # ,C
"!\xe7!" => 'c', # ,c
"!\xd1!" => 'N', # N~
"!\xf1!" => 'n', # n~
"!\xdf!" => 'ss'
);
$find = array_keys($HighASCII);
$replace = array_values($HighASCII);
$s = preg_replace($find,$replace,$s);
return $s;
}

space-seperated tag parser

function ParseTagString($sTagString)
{
$arTags = array(); // Array of Output
$cPhraseQuote = null; // Record of the quote that opened the current phrase
$sPhrase = null; // Temp storage for the current phrase we are building

// Define some constants
static $sTokens = " \r\n\t"; // Space, Return, Newline, Tab
static $sQuotes = "'\""; // Single and Double Quotes

// Start the State Machine
do
{
// Get the next token, which may be the first
$sToken = isset($sToken)? strtok($sTokens) : strtok($sTagString, $sTokens);

// Are there more tokens?
if ($sToken === false)
{
// Ensure that the last phrase is marked as ended
$cPhraseQuote = null;
}
else
{
// Are we within a phrase or not?
if ($cPhraseQuote !== null)
{
// Will the current token end the phrase?
if (substr($sToken, -1, 1) === $cPhraseQuote)
{
// Trim the last character and add to the current phrase, with a single leading space if necessary
if (strlen($sToken) > 1) $sPhrase .= ((strlen($sPhrase) > 0)? ' ' : null) . substr($sToken, 0, -1);
$cPhraseQuote = null;
}
else
{
// If not, add the token to the phrase, with a single leading space if necessary
$sPhrase .= ((strlen($sPhrase) > 0)? ' ' : null) . $sToken;
}
}
else
{
// Will the current token start a phrase?
if (strpos($sQuotes, $sToken[0]) !== false)
{
// Will the current token end the phrase?
if ((strlen($sToken) > 1) && ($sToken[0] === substr($sToken, -1, 1)))
{
// The current token begins AND ends the phrase, trim the quotes
$sPhrase = substr($sToken, 1, -1);
}
else
{
// Remove the leading quote
$sPhrase = substr($sToken, 1);
$cPhraseQuote = $sToken[0];
}
}
else
$sPhrase = $sToken;
}
}

// If, at this point, we are not within a phrase, the prepared phrase is complete and can be added to the array
if (($cPhraseQuote === null) && ($sPhrase != null))
{
$sPhrase = strtolower($sPhrase);
if (!in_array($sPhrase, $arTags)) $arTags[] = $sPhrase;
$sPhrase = null;
}
}
while ($sToken !== false); // Stop when we receive FALSE from strtok()
return $arTags;
}

convert string to hex

function string2hex($string)
{
$hex = NULL;
for ($i=0; $i < strlen($string); $i++)
{
$ord = ord(substr($string,$i,1));
if($ord < 16) {
$hex.= '0'.dechex($ord);
} else {
$hex.= dechex($ord);
}
if ($i && ($i % 32) == 31) {
$hex.= "\n";
}
}
return $hex;
}

convert hex to string

function hex2string($hex)
{
$string = NULL;
$hex = str_replace(array("\n","\r"), "", $hex);
for ($i=0; $i < $strlen($hex);$i++)
{
$string.= chr(hexdec(substr($hex, $i, 2)));
}
return $string;
}