مرجع توابع دلفی

[دلفــي]

Procedures
=======
Abort
Append
AppendStr
Assign
AssignFile
AssignPrn
Beep
BlockRead
BlockWrite
Break
ChDir
Close
CloseFile
Continue
DateTimeToString
Dec
DecodeDate
DecodeDateTime
DecodeTime
Delete
Dispose
EndThread
Erase
Exclude
Exit
FillChar
Flush
FreeAndNil
FreeMem
GetDir
GetLocaleFormatSettings
Halt
Inc
Include
Insert
MkDir
Move
New
ProcessPath
Randomize
Read
ReadLn
ReallocMem
Rename
ReplaceDate
ReplaceTime
Reset
ReWrite
RmDir
RunError
Seek
SetLength
SetString
ShowMessage
ShowMessageFmt
ShowMessagePos
Str
Truncate
Val
Write
WriteLn


Functions
======
Abs
Addr
AnsiCompareStr
AnsiCompareText
AnsiContainsStr
AnsiContainsText
AnsiEndsStr
AnsiIndexStr
AnsiLeftStr
AnsiLowerCase
AnsiMatchStr
AnsiMidStr
AnsiPos
AnsiReplaceStr
AnsiReverseString
AnsiRightStr
AnsiStartsStr
AnsiUpperCase
ArcCos
ArcSin
ArcTan
Assigned
BeginThread
Bounds
CelsiusToFahrenheit
ChangeFileExt
Chr
CompareStr
CompareText
CompareValue
Concat
Convert
Copy
Cos
CreateDir
CurrToStr
CurrToStrF
Date
DateTimeToFileDate
DateTimeToStr
DateToStr
DayOfTheMonth
DayOfTheWeek
DayOfTheYear
DayOfWeek
DaysBetween
DaysInAMonth
DaysInAYear
DaySpan
DegToRad
DeleteFile
DirectoryExists
DiskFree
DiskSize
DupeString
EncodeDate
EncodeDateTime
EncodeTime
EndOfADay
EndOfAMonth
Eof
Eoln
Exp
ExtractFileDir
ExtractFileDrive
ExtractFileExt
ExtractFileName
ExtractFilePath
FahrenheitToCelsius
FileAge
FileDateToDateTime
FileExists
FileGetAttr
FilePos
FileSearch
FileSetAttr
FileSetDate
FileSize
FindClose
FindCmdLineSwitch
FindFirst
FindNext
FloatToStr
FloatToStrF
ForceDirectories
Format
FormatCurr
FormatDateTime
FormatFloat
Frac
GetCurrentDir
GetLastError
GetMem
Hi
High
IncDay
IncMillsecond
IncMinute
IncMonth
IncSecond
IncYear
InputBox
InputQuery
Int
IntToHex
IntToStr
IOResult
IsInfinite
IsLeapYear
IsMultiThread
IsNaN
LastDelimiter
Length
Ln
Lo
Log10
Low
LowerCase
Max
Mean
MessageDlg
MessageDlgPos
Min
MonthOfTheYear
Now
Odd
Ord
ParamCount
ParamStr
Pi
Point
PointsEqual
Pos
Pred
Printer
PromptForFileName
PtInRect
RadToDeg
Random
RandomRange
RecodeDate
RecodeTime
Rect
RemoveDir
RenameFile
Round
SeekEof
SeekEoln
SelectDirectory
SetCurrentDir
Sin
SizeOf
Slice
Sqr
Sqrt
StringOfChar
StringReplace
StringToWideChar
StrScan
StrToCurr
StrToDate
StrToDateTime
StrToFloat
StrToInt
StrToInt64
StrToInt64Def
StrToIntDef
StrToTime
StuffString
Succ
Sum
Tan
Time
TimeToStr
Tomorrow
Trim
TrimLeft
TrimRight
Trunc
UpCase
UpperCase
VarType
WideCharToString
WrapText
Yesterday

[Felony]

به هر حال كار خوبي بود و اميد وارم اين كار در مورد ليست توابع API هم انجام بشه حالا هر كدوم از دوستان كه دسترسي به منبعي دارند اعلام كنند.
و مایکروسافت MSDN را آفرید ...

[دلفــي]

من در حال نوشتن یه برنامه برای توابع و پروسیجر های دلفی هستم که شامل یونیت ها و توضیح مختصری در مورد هر تابع یا پروسیجر باشد .
تا یه قسمتهاییش رو تمام کردم اگه دوستان کمک کنند بقیه موارد رو هم تموم می کنم و در اختیار بقیه قرار میدم .

من در فایل پیوست توضیحات انگلیسی توابع رو قرار دادم اگر از دوستان تو ترجمه دستی داره لطف کنه معنی اونها رو سطر به سطر در یه فایل تکست بزاره تا به برنامه اضافه کنم .


http://img39.imagefra.me/img/img39/1/11/17/yalanemail/f_ju1eju44rm_3909e20.jpg

[Hadi_Fayyaz]

سلام دوست عزيز
اگه منظور شما فقط ترجمه اين متني هست كه فرستاديد بايد بگم من فكر نميكنم نيازي به اين كار باشه چون به هر حال همه دوستان در حدي كه بتونند اين متن رو بخونند اطلاعات دارند
و اگه ميخوايد در مورد هر كدوم از موضوعات اون متن توضيح داده بشه بايد بگم كار خيلي وقت گيريه و اگه ميخوايد اين كار انجام بشه بهتره اين متن رو به قطعات كوچك تقسيم كني و توي اين تاپيك بگذاري تا هركدوم از دوستان يه بخشي رو انتخاب كنند و كاملش كنند. اينجوري زود تر به جواب ميرسي.
موفق باشي

[hamidrah]

سلام دوست عزیز
کار ارزشمندیه امیدوارم موفق باشی هر کمکی از دستم بر بیاد در راه گسترش علم انجام میدم.راستی فایل پیوستت دانلود نمیشه یه بررسی انجام بده.
یا علی

[Mahmood_M]

ممنون ، مفید خواهد بود ...
ولی بهتر بود نام توابع رو هم همراه با توضیحات توی فایل می نوشتید ، در این صورت بهتر می شد ترجمه کرد ، ترجمه باید مفهومی باشه نه لفظی ...

با تشکر از فعالیت مفیدتون ، بنده در حال ترجمه کردن هستم ولی برای برخی توابع باید نام تابع رو هم دونست و توضیحات رو با توجه به مثال عملی ترجمه کرد ...

موفق باشید ...

[دلفــي]

اگه منظور شما فقط ترجمه اين متني هست كه فرستاديد بايد بگم من فكر نميكنم نيازي به اين كار باشه چون به هر حال همه دوستان در حدي كه بتونند اين متن رو بخونند اطلاعات دارند


ممنون از پیشنهادی که دادین ، ولی چه اشکالی داره توضیحات به زبان فارسی هم وجود داشته باشند !
به هر حال افرادی هم هستند که تازه به این عرصه پا گذاشته اند و شاید تحلیل متون انگلیسی برایشان کمی سخت و گیج کننده باشد !



و اگه ميخوايد در مورد هر كدوم از موضوعات اون متن توضيح داده بشه بايد بگم كار خيلي وقت گيريه و اگه ميخوايد اين كار انجام بشه بهتره اين متن رو به قطعات كوچك تقسيم كني و توي اين تاپيك بگذاري تا هركدوم از دوستان يه بخشي رو انتخاب كنند و كاملش كنند. اينجوري زود تر به جواب ميرسي.



این هم پیشنهاد خوبیه !
ولی فکر نمی کنم وقت زیادی ببره مخصوصا برای اونایی که ترجمه انگلیسیشون خوب باشه !



کار ارزشمندیه امیدوارم موفق باشی هر کمکی از دستم بر بیاد در راه گسترش علم انجام میدم.راستی فایل پیوستت دانلود نمیشه یه بررسی انجام بده.



دانلود مشکلی نداره !

باز من دوباره آپلود می کنم .



ولی بهتر بود نام توابع رو هم همراه با توضیحات توی فایل می نوشتید ، در این صورت بهتر می شد ترجمه کرد ، ترجمه باید مفهومی باشه نه لفظی ...



زیاد نمی خواد توضیح بدید چون مفهوم اکثر توابع در نام خود اونها وجود داره من این کار رو فقط می خوام برای افرادی انجام بشه که خیلی مبتدی هستند وگرنه اکثر دوستان برنامه نویس با نام و طرز کار این توابع آشنا هستند . به هر حال به روی چشم شما هر کجا لازم داشتید برام PM بزنید تا نام توابعی رو که نیاز دارید براتون بفرستم , چون این توابع رو من از کتاب ها دارم در میارم کار وقتگیریه لذا اگه می تونید با همین فایل سر کنید .

با تشکر

[Mahmood_M]

من منتظر کمک و پیشنهاد دوستان هستم !
من در حال ترجمه هستم ، شاید تا فردا تموم بشه ...
پیشنهاد می کنم نرم افزار رو کمی جامع تر کنید و به عنوان مثال برای هر تابع یک مثال هم قرار بدید ، این طوری بسیار مفید خواهد بود ...

...

[دلفــي]

این هم یه کتاب جامع برای استفاده از توابع API در دلفی برای سیستم عامل ویندوز :

40105

40106

40107

40108

40109

40268

[دلفــي]

و این هم یه کتاب جامع برای استفاده از توابع API در دلفی برای سیستم عامل لینوکس :

40115

40116

40117

40118

40119

[دلفــي]

1. API function of the network
WNetAddConnection with the creation of a network of
permanent link
WNetAddConnection2 with the creation of a network connection
WNetAddConnection3 with the creation of a network connection
WNetCancelConnection the end of a network connection
WNetCancelConnection2 the end of a network connection
WNetCloseEnum the end of the first enumeration operation
WNetConnectionDialog start of a standard dialog box in order
to establish connections with the network resources
WNetDisconnectDialog start of a standard dialog box in order
to disconnect the connection with network resources
WNetEnumResource enumeration of network resources
WNetGetConnection access to local or connected to a network
resource name
WNetGetLastError access network expansion error error
message
WNetGetUniversalName access to a network of remote file name
and / or UNC (Universal Naming norms) name
WNetGetUser access to a network connection to the name
WNetOpenEnum start of network resources to conduct the
enumeration process
2. API function of the news
BroadcastSystemMessage system will be a message broadcast
system to all of the top-level window
GetMessagePos queue to obtain information on a message that
we have dealt with when the mouse pointer location of the
screen
GetMessageTime queue to obtain information on a message that
we have dealt with when the time
PostMessage a message will be delivered to a specific window
of the message queue
PostThreadMessage a message will be delivered to the
application
RegisterWindowMessage access to a string identifier assigned
to the message ID
ReplyMessage reply to a message
SendMessage call a window of the window function, a message
will be sent to the window
SendMessageCallback will be sent a message window
SendMessageTimeout window to send a message
SendNotifyMessage window to send a message

3. API's document processing function
CloseHandle to close a core target. Including documents,
maps, process, thread, security and synchronization objects,
such as
CompareFileTime comparison of the two papers time
CopyFile to copy files
CreateDirectory to create a new directory
CreateFile open and create documents, pipeline, mail slot,
communications services, equipment and console
CreateFileMapping to create a new document mapping target
DeleteFile to delete the specified files
DeviceIoControl on the implementation of the equipment
designated by the operation
DOS will DosDateTimeToFileTime the date and time value into
a value win32 FILETIME
FileTimeToDosDateTime a win32 FILETIME value of the DOS into
the date and time value
FileTimeToLocalFileTime a FILETIME structure to the cost of
conversion time
FileTimeToSystemTime according to a FILETIME structure, a
loading structure SYSTEMTIME
FindClose to close by the FindFirstFile function to create a
search handle
FindFirstFile According to the document file name to find
According to the FindNextFile call FindFirstFile function of
a specified file name to find the next file
FlushFileBuffers designated for the file handle, set within
the buffer zone file
FlushViewOfFile document will be written into the buffer
zone map of all the data to the disk set
GetBinaryType to determine whether the documents can be
implemented
GetCompressedFileSize judge in a compressed file on the disk
occupied by the actual number of bytes
GetCurrentDirectory loaded in a buffer zone in the current
directory
GetDiskFreeSpace access to a disk with information about the
organization, as well as the capacity to understand the
remaining space
GetDiskFreeSpaceEx access to a disk with the organization as
well as the remaining capacity of the space-related
information
GetDriveType a disk drive to determine the type of
GetExpandedName to obtain a compressed file full name
GetFileAttributes designated to determine the properties of
paper
GetFileInformationByHandle this function provides access to
information documents a mechanism
GetFileSize determine the length of documents
GetFileTime to obtain the documents specified time
information
GetFileType given in the paper handles the premise, to
determine the type of document
GetFileVersionInfo support from the tag version of a paper
version of the module, access to information
GetFileVersionInfoSize version includes resources for a
paper version of the document to accommodate the information
to determine the need for a little buffer
GetFullPathName access to the document specified the full
path name
GetLogicalDrives system to determine what the logical drive
letter
GetLogicalDriveStrings access to a string, which contains
all the logic of the current drive to the root drive path
GetOverlappedResult an overlap to determine the current
operating state
GetPrivateProfileInt for the initialization file (. Ini
file) specified in the entry to obtain an integer value
GetPrivateProfileSection access to the designated section
(in. Ini file) all items of value and a list of
GetPrivateProfileString for the initialization file
specified in the entry made string
GetProfileInt made win.ini initialization file specified in
the entry of an integer value
GetProfileSection access to the designated section (in the
win.ini file) all items of value and a list of
GetProfileString for initialization win.ini file specified
in the entry made string
GetShortPathName access to the documents specified a short
path name
GetSystemDirectory get Windows system directory (that is,
the System directory) of the full path name
GetTempFileName function that includes a temporary file
name, it may be the use of applications
GetTempPath obtain a temporary file path specified
GetVolumeInformation access to a disk and volume-related
information
GetWindowsDirectory access to the Windows directory full
path name
hread reference lread
hwrite reference function lwrite
lclose designated by the closure of the paper
Create a file lcreat
llseek settings file Reading and Writing for the current
location
LockFile part of a locked file so that it is not shared with
other applications
LockFileEx and LockFile similar, but it provides more
functionality
lopen binary mode to open the specified file
lread document will be read into the data in the memory
buffer
lwrite data from the memory buffer to write a paper
LZClose by the closure of LZInit or LZOpenFile function to
open a file
LZCopy copy of a document
LZInit this function within the buffer zone used to
initialize
LZOpenFile the function to carry out a large number of
different document processing, but also compatible to the
compressed file
LZRead data from the document read into the buffer memory
LZSeek set up a file for reading and writing in the current
location
MapViewOfFile a document mapping the object is mapped to the
current application of the address space
MoveFile mobile document
OpenFile this function to carry out a large number of
different file operations
OpenFileMapping ready to open a document mapping target
QueryDosDevice in Windows NT in, DOS device name will be
mapped into NT systems of equipment. The function can judge
the current situation in mapping equipment
ReadFile from the document Duchushuju
ReadFileEx with ReadFile similar, but it can only be used
for asynchronous read operation, and includes a complete
callback
RegCloseKey closure of the registry system, a key (or keys)
RegConnectRegistry visit to a remote part of the system
registry
RegCreateKey under the specified create or open an item
RegCreateKeyEx specified under the new creation of a more
complex way. In the Win32 environment, recommend the use of
this function
RegDeleteKey to delete the existing one at the bottom of the
designated sub-items
RegDeleteValue delete items below a specified value
RegEnumKey enumeration of designated sub-items. In the Win32
environment should be used RegEnumKeyEx
RegEnumKeyEx enumeration of designated at the bottom of the
sub-item
RegEnumValue enumeration of the specified value
RegFlushKey will and its sub-items to make changes to the
actual disk write
RegGetKeySecurity with access to a registry of securityrelated
information
RegLoadKey from the previous RegSaveKey function with the
creation of a document containing information registry
RegNotifyChangeKeyValue registry or any of its sub-items of
a change, use this function to provide a notification
mechanism
RegOpenKey to open an existing registry entries
RegOpenKeyEx to open an existing item. In the next win32
recommended this function
RegQueryInfoKey access and a related information
RegQueryValue or to obtain a sub-item of default (unnamed)
value
RegQueryValueEx acquisition of a set of values
RegReplaceKey disk with a file of information to replace
registry information; and to create a backup, including in
the current registry information
RegRestoreKey from one disk to restore the registry file
information
RegSaveKey one item, as well as all of its sub-items are
saved to a disk file
RegSetKeySecurity designated set of security features
RegSetValue or designated sub-set of default value
RegSetValueEx designated set of values
RegUnLoadKey designated by the unloading of all, as well as
its sub-items
RemoveDirectory to delete the specified directory
SearchPath find the specified file
SetCurrentDirectory set the current directory
SetEndOfFile for an open document, the current location of
the document is set at the end of the document
SetFileAttributes set file attributes
SetFilePointer in a document setting the current location of
the reading and writing
SetFileTime create a set of documents, interviews and last
modified
SetHandleCount this function does not have to use win32;
even if the use does not have any effect
SetVolumeLabel a set of disk label (Label)
SystemTimeToFileTime according to a FILETIME structure, the
structure included in a SYSTEMTIME
UnlockFile lifting of a locked file
UnlockFileEx lifting of a locked file
UnmapViewOfFile in the current application of the memory
address space for the lifting of a document mapping object
mapping
VerFindFile decided to use this function should be to
install a file where
VerInstallFile use this function to install a file
VerLanguageName be able to function in accordance with the
16-bit code language to obtain the name of the language
VerQueryValue for this function from the version of access
to information resources
WriteFile data will be written into a document
WriteFileEx and WriteFile similar, but it can only be used
to write asynchronous operation, and includes a complete
callback
WritePrivateProfileSection an initialization file (. Ini)
specified in the section set of all values and
WritePrivateProfileString initialization file specified in
the section set up a string
WriteProfileSection for the Win.ini file to initialize a
designated section of all the settings and values
WriteProfileString in the Win.ini file initialization
settings within the designated section of a string

[دلفــي]

4. API's print function
AbortDoc cancel a print document
AbortPrinter and delete a printer associated with the file
buffer
AddForm form of a list of printers to add a new form
AddJob used to obtain an effective path, in order to use it
for the printing operations to create a background document.
It will also work for the distribution operations of a
number
AddMonitor system to add a printer monitor
AddPort start the "Add Port" dialog box, the system allows
users to the list of available ports to add a new port
AddPrinter in the system to add a new printer
AddPrinterConnection designated printer connection
AddPrinterDriver designated for the system to add a print
driver
AddPrintProcessor designated for the system to add a print
processor
AddPrintProvidor system to add a print provider
AdvancedDocumentProperties start document printer settings
dialog box
ClosePrinter closed to open a printer object
ConfigurePort designated for the port, a port configuration
dialog box to start
ConnectToPrinterDlg start to connect the printer dialog box,
use it to access the same network printer connections
DeleteForm printers available from the form of a list form
DeleteMonitor to delete the specified print monitor
DeletePort start "to remove port" dialog box that allows
users to delete from the current system, a port
DeletePrinter will be designated by the printer for the
signs be removed from the system
DeletePrinterConnection to delete the printer connected with
the designated
DeletePrinterDriver deleted from the system, a printer
driver
DeletePrintProcessor from the designated system to delete a
printing processor
DeletePrintProvidor from the system to delete a print
provider
DeviceCapabilities use of the available functions and the
ability of a device-related information
DocumentProperties printer configuration control function
EndDocAPI the end of a successful print job
EndDocPrinter Print Spooler in the document to specify a
level of the end of the
EndPage use this function to complete a page of print and
equipment to prepare the scene in order to print the next
page
EndPagePrinter specify a page in the print job in the end
EnumForms enumerate a printer available form
EnumJobs enumeration in the print queue operation
EnumMonitors enumeration can be used to print the Monitor
EnumPorts enumeration of a system available port
EnumPrinterDrivers designated enumeration system has been
installed in the printer driver
EnumPrinters enumeration system installed in the printer
EnumPrintProcessorDatatypes enumerated by the print
processor to support a data type
EnumPrintProcessors enumeration system can be used in the
print processor
Escape device control function
FindClosePrinterChangeNotification closed
FindFirstPrinterChangeNotification function with access to a
printer circular object
FindFirstPrinterChangeNotification to create a new circular
to change the target so that we pay attention to the printer
status changes
FindNextPrinterChangeNotification used to determine the
function printers to trigger a signal change notice of the
reasons
FreePrinterNotifyInfo released by the
FindNextPrinterChangeNotification distribution function of a
buffer zone
GetForm made with the designated form-related information
GetJob access to the designated operations and related
information
GetPrinter made with the designated printer-related
information
GetPrinterData registry settings for the printer
configuration information
GetPrinterDriver designated for printers, printer driver and
access to relevant information
GetPrinterDriverDirectory judge designated system includes a
printer driver directory of what is
GetPrintProcessorDirectory judge designated system includes
a processor printer driver files and directories
OpenPrinter open the designated printer, and access to the
printer handle
PrinterMessageBox in the print job has a designated system
to show a printer error message box
PrinterProperties start the printer properties dialog box in
order to configure the printer
ReadPrinter read data from the printer
ResetDC reset a device scene
ResetPrinter change the default printer specified types of
data files and settings
ScheduleJob submitted to a printing operation
SetAbortProc for the abolition of the designated function of
the Windows Address
SetForm specified form settings for information
SetJob of a print job status control
SetPrinter on the status of a printer control
SetPrinterData set up the printer configuration information
registry
StartDoc to start a print job
StartDocPrinter print in the background level of the start
of a new document
A StartPage printing a new page before calling the function
StartPagePrinter in the print job is specified in the
beginning of a new page
WritePrinter will send the directory data into the printer
5. API of the text font and function
AddFontResource in the Windows system to add a font of
resources
CreateFont designated by the property to create a logical
font
CreateFontIndirect designated by the property to create a
logical font
CreateScalableFontResource a TureType fonts to create a
resource document in order to use API function
AddFontResource its accession to the Windows system
DrawText text will be painted to a specific rectangular in
DrawTextEx and DrawText similar, but adding more features
EnumFontFamilies designated list of equipment available
fonts
EnumFontFamiliesEx designated list of equipment available
fonts
EnumFonts designated list of equipment available fonts
ExtTextOut through the expansion of the text describing the
function. Please refer to the function also SetTextAlign
GetAspectRatioFilterEx request SetMapperFlags with Windows
only with the choice of equipment in line with the aspect
ratio of the current raster fonts, this function can judge
small aspect ratio
GetCharABCWidths judge TureType fonts in one or more of the
character of the size ABC
GetCharABCWidthsFloat characters in a query to one or more
characters of the size ABC
GetCharacterPlacement learn how to use this function with a
given string of characters that a
GetCharWidth investigation fonts in one or more of the width
of the characters
GetFontData receive a scalable font file data
GetFontLanguageInfo return to the current opt-specified
device font scenarios information
GetGlyphOutline made TureType font of the characters in a
curve information
GetKerningPairs to obtain a font of information kerning
GetOutlineTextMetrics receive TureType fonts and internal
features of the details
GetRasterizerCaps understanding of the system's ability to
support scalable fonts
GetTabbedTextExtent a string to determine the scope of the
occupation, taking tabulation stop the expansion of the
factors
GetTextAlign scene equipment to receive a copy of the
current alignment mark
GetTextCharacterExtra additional characters to judge the
distance between the current value
GetTextCharset to receive the current opt-scenes equipment
specified font character set identifier
GetTextCharsetInfo access to the current selection of fonts
and character set-related details
GetTextColor to determine the current font color. Usually
referred to as "Foreground"
GetTextExtentExPoint judge to fill in the designated area of
the number of characters. Also loaded with an array of
characters in each of the scope of information
GetTextExtentPoint a string to determine the size of the
(scope)
GetTextFace access to a font of the words
GetTextMetrics access into the election with a scene of
physical device font-related information
GrayString painted gray to a string of shows. Windows logo
usually used to prohibit the state
PolyTextOut described a series of string
RemoveFontResource from the Windows system to delete a font
of resources
SetMapperFlags Windows fonts on the map, can be used to
choose the functions and objectives of equipment in line
with the aspect ratio of grating characters
SetTextAlign set text alignment, and designated in the text
output in the process of using the device's current location
of the scene
SetTextCharacterExtra described the text, specify the
characters inserted between the additional space
SetTextColor to set the current text color. This color is
also known as "Foreground"
SetTextJustification through a designated line of text
should take the extra space can be used to carry out the
function of the text dealing with both ends of the alignment
TabbedTextOut support for the tabulation of the station
described the text of a function
TextOut text mapping function

[دلفــي]

6. API on the menu function

AppendMenu specified in the menu, add a menu item

CheckMenuItem check or check to withdraw the designated menu
items

CheckMenuRadioItem menu items to be designated a check as a
"radio"

CreateMenu create a new menu

CreatePopupMenu to create a space of the pop-up menu

DeleteMenu to delete the specified menu items

DestroyMenu to delete the specified menu

DrawMenuBar designated for the re-drawing of the window menu

EnableMenuItem to allow or prohibit the designated menu
items

GetMenu get a window handle the menu

GetMenuCheckMarkDimensions a menu to return to check the
size of the site

GetMenuContextHelpId get a menu of the scene to help ID

GetMenuDefaultItem to determine which of the menu items is
the default entry

GetMenuItemCount return to the menu items (menu item) the
number of

GetMenuItemID return to the menu at the designated position
of the menu items ID

GetMenuItemInfo made (receiver) and a menu entries related
to the specific information

GetMenuItemRect in a rectangular load in the designated
entry in the menu screen coordinates information

GetMenuState designated menu items made with the staterelated
information

GetMenuString to obtain a string of menu items

GetSubMenu get a pop-up menu handle, which is located in the
menu to specify the location of

GetSystemMenu to obtain a window handle the menu system
Control menu entries HiliteMenuItem top of the display
highlighting the state

InsertMenu menu at the designated position to insert a menu
entry, and in accordance with the needs of the other entries
down

InsertMenuItem insert a new menu entry

IsMenu to determine whether or not designated as a handle to
handle the menu

LoadMenu from the specified module or application examples
include a menu

LoadMenuIndirect included in a menu

MenuItemFromPoint judge which of the menu contains entries
on the screen of a designated point

ModifyMenu change menu items

RemoveMenu to delete the specified menu items

SetMenu window settings menu

SetMenuContextHelpId to set up a menu of the scene to help
ID

SetMenuDefaultItem a menu entry set to the default entry

SetMenuItemBitmaps set a specific bitmap, it specified the
use of the menu items, instead of the standard check symbol
(.)

SetMenuItemInfo a menu entry setting the specified
information

TrackPopupMenu any place on the screen display a pop-up menu

TrackPopupMenuEx and TrackPopupMenu similar, but it provides
additional functionality

7. API of bitmaps, icons and grating computing function

BitBlt to a bitmap copy from one device to another scene

CopyIcon production designated icon or a copy of the mouse
pointer. The call issued by the subordinate to a copy of the
application

CopyImage copy bitmaps, icons or indicators, while in the
process of copying some conversion work

CreateBitmap in accordance with the provisions of the format
and equipment related to the creation of a bitmap

CreateBitmapIndirect and equipment related to the creation
of a bitmap

CreateCompatibleBitmap and equipment related to the creation
of a bitmap, which designated the scenes of compatible
equipment

CreateCursor to create a mouse pointer

CreateDIBitmap based on a device-independent bitmap and
equipment related to the creation of a bitmap

CreateDIBSection create a DIBSection

CreateIcon to create a logo

CreateIconIndirect to create a logo

DestroyCursor designated by the removal of the mouse
pointer, and the release of its occupation of all system
resources

DestroyIcon clear icon
At the designated position DrawIcon painting an icon

DrawIconEx or icon depicting a mouse pointer. DrawIcon and
compared this function to provide more functionality

ExtractAssociatedIcon an executable program to determine
whether there is or DLL icon, or whether there is a icon
with the system registry specified in the document the
existence and relevance of extraction

ExtractIcon an executable file to determine whether or DLL
icon exists, and extracted

GetBitmapBits from bitmap to copy the binary bit of a buffer
zone

GetBitmapDimensionEx made a bitmap of the width and height

GetDIBColorTable opt-in equipment from the scene of
DIBSection made in the color table information

GetDIBits will come from a binary bitmap-to copy a deviceindependent
bitmap,

GetIconInfo icon with access to relevant information

GetStretchBltMode judge StretchBlt and StretchDIBits

function of the use of flexible model

LoadBitmap from the specified module or application examples
include a bitmap

LoadCursor from the specified module or application examples
include a mouse pointer

LoadCursorFromFile pointer in a document or an animation
file pointer on the basis of the creation of a pointer

LoadIcon from the specified module or application examples
include an icon

LoadImage to load a bitmap, icon or indicator

MaskBlt the implementation of complex image transmission, at
the same time mask (MASK) to deal with

PatBlt the current brush selected on the basis of a pattern
designated by the equipment-filled scenes

PlgBlt to copy a bitmap, at the same time convert it into a
parallelogram. It can be bitmap carried out on rotation to
deal with

SetBitmapBits from the buffer zone of binary digital copy to
a bitmap

SetBitmapDimensionEx set the width of a bitmap. 1 millimeter
to one-tenth of the unit

SetDIBColorTable set up an opt-in equipment DIBSection scene
of a color table information
From the equipment SetDIBits has nothing to do with the
binary bitmap-to reproduce with a bitmap-related equipment,

SetDIBitsToDevice will be a device-independent bitmap in
whole or in part to copy data directly to a device

SetStretchBltMode designated StretchBlt and StretchDIBits

function of the expansion mode

StretchBlt to a bitmap copy from one device to another scene

StretchDIBits will be a device-independent bitmap in whole
or in part to copy data directly to a specific scene
equipment

8. API function of the graphics

AbortPath opt to abandon the scene of equipment specified in
the path of all. Also cancel any ongoing work to create the
path

AngleArc an arc to connect a line drawing
An arc Arc paintings

BeginPath start a branch of the path

CancelDC cancel another thread in the mapping operation for
a long time
Chord painting of a string

CloseEnhMetaFile designated by the closure of the Enhanced
Metafile scene equipment, and new Metafile return a handle

CloseFigure to describe a path, the current closure of the
open graphics

CloseMetaFile designated by the closure of the Metafile
scene equipment, and new Metafile return a handle

CopyEnhMetaFile designated to produce enhanced metafile a
copy of the (copy)

CopyMetaFile designated production (standard) Metafile a
copy of the

CreateBrushIndirect in LOGBRUSH a data structure on the
basis of the creation of a brush

CreateDIBPatternBrush with a device-independent bitmap to
create a brush, brush in order to specify the style
(pattern)

CreateEnhMetaFile creation of an enhanced metafile equipment
Scene

CreateHatchBrush the shadow patterns created with a brush

CreateMetaFile to create a scene equipment Metafile

CreatePatternBrush designated by the brush of a bitmap
images to create a brush

CreatePen designated by the style, color and width to create
a brush
According to the CreatePenIndirect designated LOGPEN
structure to create a brush

CreateSolidBrush to create a solid color with brush

DeleteEnhMetaFile delete designated Enhanced Metafile

DeleteMetaFile to delete the specified Metafile

DeleteObject to delete GDI object, the object of the use of
all system resources will be released

DrawEdge designated by the style of a painted rectangular
frame

DrawEscape escape (Escape) function data directly to the
display device driver
Painting a Rectangle focus DrawFocusRect
DrawFrameControl describe a standard control

DrawState for an image or graphics application to operate a
wide range of effects
Ellipse painted an oval, rectangular designated by the
surrounding

EndPath stop the definition of a path

EnumEnhMetaFile for an enhanced metafile, which cited a
separate metafile record

EnumMetaFile as a standard windows Metafile separate
enumeration of the metafile record

EnumObjects enumeration can be designated along with
equipment used by scenes of the brush and brush

ExtCreatePen extended to create a brush (or geometric
decoration)

ExtFloodFill equipment in the designated scene, with the
current selection of a brush-filled area

FillPath to close any open the path of graphics, and the
current brush-filled

FillRect designated by a brush-filled rectangular

FlattenPath a path all the curves are converted into
segments

FloodFill with the currently selected brush at the specified
device to fill a scene in the region

FrameRect designated by the brush around a rectangular frame
of a painting

GdiComment designated for the Enhanced Metafile equipment
scenes add a note of information

GdiFlush the implementation of any outstanding graphics
operation

GdiGetBatchLimit to determine the number of GDI drawing
commands at the queue
The number of designated GdiSetBatchLimit graphics GDI order
to enter the queue

GetArcDirection arc paintings, drawings used to determine
the current direction

GetBkColor equipment to obtain a scene of the current
background color

GetBkMode equipment designated for the scene, made to fill
the background of the current model

GetBrushOrgEx designated equipment to determine the current
scene selected brush starting point

GetCurrentObject was designated types of the currently
selected object

GetCurrentPositionEx equipment in the designated scene to
obtain the current location of the brush

GetEnhMetaFile disk access to documents contained in an
enhanced metafile handle the metafile

GetEnhMetaFileBits will be designated by the Enhanced
Metafile copy to a memory buffer in

GetEnhMetaFileDescription return for an enhanced metafile
note

GetEnhMetaFileHeader achieve enhanced metafile of the first
Metafile

GetEnhMetaFilePaletteEntries achieve enhanced metafile all
or part of the palette

GetMetaFile to obtain a disk included in the document of the
Metafile Metafile handle

GetMetaFileBitsEx will be designated by the metafile copy to
a memory buffer

GetMiterLimit to obtain equipment restrictions on the slope
of the scene (Miter) set

GetNearestColor equipment in accordance with the display
capability, and access to the nearest designated color of a
solid color

GetObjectAPI made to the designated target for a description
of the structure

GetObjectType designated by the judge cited the GDI handle
the type of target

GetPath made on the current path defined by a series of data

GetPixel equipment in the designated scene to obtain a pixel
RGB value

GetPolyFillMode equipment designated for the scene to obtain
Polygon fill mode
Facilities GetROP2 for the designated scene, to obtain the
current graphics mode

GetStockObject to obtain a natural object (Stock)

GetSysColorBrush for any of the standard color system to
obtain a brush

GetWinMetaFileBits through a buffer to fill in for the
standard metafile data will be an enhanced metafile
converted to standard windows metafile

InvertRect through the inversion of the value of each pixel
in order to reverse a scene of equipment specified in the
rectangular

LineDDA enumeration of all segments designated point

LineTo with the current number of strokes of a painting
line, even from its current location to a designated point

MoveToEx equipment designated for the designation of a new
scene of the current location of the brush

PaintDesk equipment in the designated scene depicting the
desktop wallpaper designs

PathToRegion the current path chosen by the conversion to a
region
Pie painting of a pie chart

PlayEnhMetaFile equipment in the designated scene in a
painting Enhanced Metafile

PlayEnhMetaFileRecord playback of a separate enhanced
metafile record

PlayMetaFile equipment in the designated scene in a replay
Metafile

PlayMetaFileRecord playback from a single metafile records

PolyBezier depict one or more Bessel (Bezier) curve

PolyDraw describe a complex curve, Bezier curves and line
segments by the composition of the
Polygon depicts a polygon

Polyline painted with the brush of the current series of
line segments

PolyPolygon painted with the brush of the current selection
of two or more polygons

PolyPolyline painted with the brush of the current selection
of two or more polygons
Rectangle with the currently selected brush painted
rectangle, and the currently selected brush-filled

RoundRect with selected paintings present a rounded
rectangular strokes, and the currently selected brush to
fill in

SelectClipPath equipment to the scene of the current path
cut into the area

SelectObject equipment for the current scene selection
graphic object

SetArcDirection describe the arc to set the direction of

SetBkColor designated for the device to set the scene
background color

SetBkMode designated shadow brush, brush dotted line and
characters to fill the gap in the way

SetBrushOrgEx equipment designated for the scenes set the
starting point for the currently selected brush

SetEnhMetaFileBits designated by the memory buffer zone that
contains the data to create an enhanced metafile

SetMetaFileBitsEx use is included in the designated buffer
memory data structure to create a Metafile

SetMiterLimit equipment set up scenes of the current
restrictions on the slope

SetPixel equipment in the designated scene to set up a pixel
RGB value

SetPixelV equipment in the designated scene to set up a
pixel RGB value

SetPolyFillMode set of polygon fill mode
SetROP2 designated set of drawings of equipment scene modes.
Vb and the property is fully consistent DrawMode
SetWinMetaFileBits a standard Windows Metafile into Enhanced
Metafile

StrokeAndFillPath equipment designated for the scene to
close the path to open all the region

StrokePath painted with the brush of the current outline of
a path. Open graphics function that will not be closed

UnrealizeObject a brush object into the election equipment
prior to the scene, as the starting point of brush to use to
amend SetBrushOrgEx, you must call this function

WidenPath selected based on the width of the brush, to
redefine the currently selected path

[دلفــي]

9. API function of the equipment scene

CombineRgn combination of the two regions for a new regional

CombineTransform drive the conversion of the world. It is
equivalent to twice the order in accordance with the
conversion

CreateCompatibleDC to create a scene of equipment in line
with the specific memory devices Scene

CreateDC equipment to create specialized equipment for the
scene

CreateEllipticRgn oval to create a

CreateEllipticRgnIndirect to create a rectangle inscribed in
a particular region of the oval

CreateIC special equipment for the information to create a
scene

CreatePolygonRgn to create a point surrounded by a series of
regional

CreatePolyPolygonRgn created by a number of polygons
constitute the region. Each polygon should be closed

CreateRectRgn to create a rectangular region

CreateRectRgnIndirect to create a rectangular region

CreateRoundRectRgn to create a rounded rectangular

DeleteDC deleted scenes and special equipment or information
on the scene, the release of all relevant resources window

DPtoLP dot matrix will coordinate transformation equipment
from the special equipment to the scene logical coordinates

EqualRgn the two regions to determine whether or not the
same

ExcludeClipRect special equipment from the scene cut away a
rectangular area in the district. Can not be carried out
within the rectangular drawing

ExcludeUpdateRgn from special equipment to remove scenes
Tailoring area designated window of the region refresh
According to the World ExtCreateRegion conversion to amend
the region
Combination ExtSelectClipRgn designated area will be the
scene of the equipment to the current crop area

FillRgn brushes with the designated filling in designated
areas

FrameRgn designated by brush painting of a designated area
around the frame

GetBoundsRect access to the scene of the equipment specified
rectangular border

GetClipBox full access to the specified device that contains
cut scenes of the smallest rectangular area

GetClipRgn access to the scene of the current crop area
equipment

GetDC access to the designated windows scene equipment

GetDCEx designated as a window to obtain equipment scene.
Compared to GetDC, this function provides more options

GetDCOrgEx access to designated locations device starting
point for the scene (to screen coordinates)

GetDeviceCaps according to the specified device on behalf of
the scene of the equipment to return to the function of
information

GetGraphicsMode to determine whether to allow enhanced
graphics mode (world converting)

GetMapMode for specific equipment transferred to the image
scene modes
A regional GetRegionData into the description of the
information or the structure of the buffer zone RgnData
GetRgnBox full access to the designated area contains the
smallest rectangle

GetUpdateRgn refresh the window to determine the designated
region. The current void in the region, the need to refresh

GetViewportExtEx access to equipment, as the scenes I
(viewport) range

GetViewportOrgEx access to port facilities, as the starting
point for the scene

GetWindowDC access to the entire window (including borders,
scroll bars, title bar, menus, etc.) equipment Scene

GetWindowExtEx access to equipment designated windows scene
of the scope of

GetWindowOrgEx access to equipment designated windows scene
of the logical starting point

GetWindowRgn window access to the region

GetWorldTransform if the conversion of the world, in order
to obtain the current world scene equipment conversion

IntersectClipRect equipment designated for the definition of
a new crop area

InvalidateRgn window so that the activities of nondesignated
areas and will add it to refresh the window area
so that it can then be re-drawn

InvertRgn every pixel upside down through the value of the
reverse scenario equipment in designated areas
Dot matrix will LPtoDP from the specified device coordinates
into a scene logic device coordinates

ModifyWorldTransform designated in accordance with the mode
of amending the conversion of the world

OffsetClipRgn specified amount of translation equipment cut
scenes District

OffsetRgn offset by the designated shift in designated areas

OffsetViewportOrgEx translation equipment, as the scene of
regional population

OffsetWindowOrgEx translation equipment designated windows
scene starting point

PaintRgn brush with the current background color to fill in
designated areas

PtInRegion determine whether the point in the designated
areas

PtVisible designated point to determine whether or not we
can see (that is, in point of equipment in the region cut
scenes)

RectInRegion determine whether there is a part of the
rectangle in the designated areas

RectVisible determine whether there is a designated part of
the rectangle can be seen (whether or not the equipment in
the region cut scenes)

ReleaseDC released by the GetDC call or function GetWindowDC

access to the equipment specified scene

RestoreDC equipment from the scene to restore a stack of
equipment to preserve the original scene

SaveDC equipment will be designated a state to preserve the
scene to Windows device stack scene

ScaleViewportExtEx scaling equipment, as the scene of the
mouth area

ScaleWindowExtEx zoom window scene equipment designated area

ScrollDC in the window (by the equipment on behalf of the
scene), and (or) vertical rectangle rolling

SelectClipRgn equipment designated for the scene to choose a
new crop area

SetBoundsRect set of equipment specified scene rectangular
border

SetGraphicsMode to allow or prohibit the enhanced graphics
mode to provide some support (including the conversion of
the World)

SetMapMode set the scene mapping equipment designated model

SetRectRgn set for the region designated by the rectangular

SetViewportExtEx equipment to set the scene as the scope of
the mouth

SetViewportOrgEx equipment to set the scene as the starting
point for the mouth

SetWindowExtEx equipment set up designated windows scene
area

SetWindowOrgEx equipment set up designated windows scene
starting point

SetWindowRgn regional settings window

SetWorldTransform set up conversion of the world

ValidateRgn activation window specified in the region, it
removed from the zone set

WindowFromDC back with a scene of equipment related to the
window handle

10. API function of the hardware and system

ActivateKeyboardLayout activation of a new keyboard layout.
Keyboard layout of the buttons in the definition of a
physical keyboard and the location of the meaning of
Beep used to generate simple voice

CharToOem a string from the ANSI character set conversion to
the OEM character set

ClipCursor pointer will be restricted to designated areas

ConvertDefaultLocale will be a special place identifier into
the local real ID

CreateCaret according to the specified information to create
a site insert (cursor), it will be selected as the
designated window at the default Insert
Clear DestroyCaret (damage) to insert a site

EnumCalendarInfo enumeration in the designated "local"
environment calendar information available

EnumDateFormats designated list of "local" setting can be
used in the long and short date format

EnumSystemCodePages enumeration system has been installed or
supported by the code page

EnumSystemLocales enumeration system has been installed to
provide support or "local" setting

EnumTimeFormats enumeration of a designated place where the
application of the time format

ExitWindowsEx from the windows, and a specific option
restarted

ExpandEnvironmentStrings expansion of the environment string
Translation FreeEnvironmentStrings designated by the
Environmental string block

GetACP judge is currently the entry into force of the ANSI
code page

GetAsyncKeyState function call to determine when the
designated virtual key state

GetCaretBlinkTime to determine Insert at the cursor blinking
frequency

GetCaretPos to determine Insert at the current location

GetClipCursor to obtain a rectangle, is used to describe the
current provisions of the mouse pointer to cut the region

GetCommandLine point to the current command-line access to
the buffer zone as a pointer

GetComputerName to obtain the name of this computer

GetCPInfo made with the designated code page-related
information

GetCurrencyFormat designated for "local" setting, according
to the currency format to format a number of

GetCursor access to the mouse pointer is currently chosen by
the handle
Acquisition of GetCursorPos the mouse pointer from its
current location

GetDateFormat designated for "local" format, a system date
format

GetDoubleClickTime to judge between the two mouse click will
be processed into double-time events

GetEnvironmentStrings to contain the current environment of
a string of set pieces of memory allocation and return a
handle

GetEnvironmentVariable to obtain an environment variable's
value

GetInputState to determine whether there are any pending
(pending) of the mouse or keyboard events

GetKBCodePage by GetOEMCP to replace the two functions
exactly the same

GetKeyboardLayout get a handle, described in the application
of the designated keyboard layout

GetKeyboardLayoutList system was applicable to all the
keyboard layout of a list

GetKeyboardLayoutName the current activities of the keyboard
layout to obtain the name of the

GetKeyboardState made each of the virtual keyboard on the
current state of key

GetKeyboardType understanding and are using the keyboardrelated
information

GetKeyNameText scan is given in the code under the premise
that key judgments were

GetKeyState for keys which have been processed in the most
recent information input, the designated judge of the state
of virtual keys

GetLastError prior to the call for the api function, use
this function to expand access to error messages

GetLocaleInfo made with the designation "local" information

GetLocalTime to obtain local date and time

GetNumberFormat designated for "local", according to the
specific format of a digital format

GetOEMCP judge in the OEM and ANSI character set conversion
between the windows code page

GetQueueStatus to judge applications pending in the message
queue (pending) of the type of information

GetSysColor designated to determine the object's color
display windows

GetSystemDefaultLangID system to obtain the default language
ID

GetSystemDefaultLCID to obtain the current default system,
"local"

GetSystemInfo made with the underlying hardware platformrelated
information

GetSystemMetrics return to windows and environment-related
information

GetSystemPowerStatus access to the current state of the
power system-related information

GetSystemTime made the current system, this time using the
"time in collaboration with the World" (UTC, also known as
GMT) format

GetSystemTimeAdjustment so that the internal system clock
and an external clock signal synchronization

GetThreadLocale get a place of the current thread ID

GetTickCount for access to windows from the start since
going through the length of time (in milliseconds)

GetTimeFormat the current designation of "local", according
to a specific format to format a system of time

GetTimeZoneInformation made with the system set the time
zone information

GetUserDefaultLangID for the current user ID to obtain the
default language

GetUserDefaultLCID to obtain the current user's default
"local" setting

GetUserName to obtain the current user's name

GetVersion judge is currently running versions of Windows
and DOS

GetVersionEx made with the platform and operating system
version of the information

HideCaret specified in the window insert hidden Fu (cursor)

IsValidCodePage to judge the effectiveness of a code page

IsValidLocale to judge the effectiveness of local identifier
keybd_event function that simulates the keyboard action

LoadKeyboardLayout included in a keyboard layout

MapVirtualKey designated in accordance with the type of map,
the implementation of the different characters and the
conversion code scanning

MapVirtualKeyEx designated in accordance with the type of
map, the implementation of the different characters and the
conversion code scanning

MessageBeep play a sound system. Sound system of
distribution in the Control Panel's decision,

mouse_event simulate a mouse event

OemKeyScan determine an OEM character set ASCII character
code and scan the Shift key state

OemToChar to OEM character set a string to the ANSI
character set conversion

SetCaretBlinkTime insert designated site (cursor) of the
frequency of blinking

SetCaretPos inserted at the designated location

SetComputerName new computer name

SetCursor will be designated by the mouse pointer as the
current indicators

SetCursorPos pointer to set the location of

SetDoubleClickTime set up between the two mouse-click system
that can be double-time events

SetEnvironmentVariable environment variable is set to a
specified value

SetKeyboardState each set of virtual keys on the keyboard in
the current state of

SetLocaleInfo the user to change the "local" set of
information

SetLocalTime set the current local time

SetSysColors set up designated window display of color
objects

SetSystemCursor change any of the standard system of
indicators

SetSystemTime set up the current system time

SetSystemTimeAdjustment from time to time a added value of
calibration so that the internal system clock and an
external clock signal synchronization

SetThreadLocale place settings for the current thread

SetTimeZoneInformation the system time zone information

ShowCaret specified in the window display at Insert (cursor)

ShowCursor control the mouse pointer visibility

SwapMouseButton decide whether to swap the mouse around the
key functions

SystemParametersInfo access and set up a large number of
windows system parameters

SystemTimeToTzSpecificLocalTime time the system will be
converted to local time

ToAscii under the current code scanning and keyboard, a
virtual keys into ASCII characters

ToUnicode in the light of current code scanners and
keyboards, will be converted into a virtual key Unicode
characters

UnloadKeyboardLayout unloading designated by the keyboard
layout

VkKeyScan for a Windows character set ASCII characters, to
determine the virtual key code and the Shift key state

[دلفــي]

11. API function of the process and thread

CancelWaitableTimer this function can be used to cancel a
wait timer operation

CallNamedPipe hope that the function of a communications
channel through the process of a customer call

ConnectNamedPipe direct a server to wait until the client
with the naming of a pipeline to connect

CreateEvent to create an event object

CreateMailslot the creation of a postal route. Postman's
return to the server by using the handle (the recipient)

CreateMutex to create a mutex (MUTEX)

CreateNamedPipe to create a named pipe. Return to handle the
pipeline by the use of server-side

CreatePipe create an anonymous pipe

CreateProcess to create a new process (such as the
implementation of a program)

CreateSemaphore create a new signal

CreateWaitableTimer create a timer to wait for the target

DisconnectNamedPipe disconnect a customer with a named pipe
connections

DuplicateHandle in an existing system that handles the
current object, that object to create a new handle

ExitProcess a suspension of the process

FindCloseChangeNotification the closure of a change to be
notified

FindExecutable to find documents associated with a specified
procedure with the file name

FindFirstChangeNotification to create a document to be
notified. The object used to monitor file system changes

FindNextChangeNotification reset to change a file to be
notified so that it continues to monitor changes in the next

FreeLibrary the release of specified dynamic-link library

GetCurrentProcess access to the current process of a pseudohandle

GetCurrentProcessId the current process of obtaining a
unique identifier

GetCurrentThread access to the current thread of a pseudohandle

GetCurrentThreadId access to the current thread a unique
identifier thread

GetExitCodeProces have access to an interruption of the
process from the code

GetExitCodeThread access to a suspension of the thread from
the code

GetHandleInformation access to a system and handle the
object-related information

GetMailslotInfo a postal routes and access to relevant
information

GetModuleFileName access to a template containing the full
path name

GetModuleHandle obtain an application or dynamic link
library module handle

GetPriorityClass access to a particular process, the
priority level

GetProcessShutdownParameters investigation shut down the
system when a specified process, as opposed to other
processes to close the case as early as late

GetProcessTimes acquisition process with a time-related
information

GetProcessWorkingSetSize an understanding of the application
running in the course of the actual delivery of it to how
much memory capacity

GetSartupInfo start of a process to obtain information

GetThreadPriority access to a particular thread priority
level

GetTheardTimes with access to a thread of time-related
information

GetWindowThreadProcessId access to the designated window
associated with a process ID and thread

LoadLibrary included in the specified dynamic-link library,
and it is mapped to the current process of using the address
space

LoadLibraryEx load the dynamic link library designated for
the current process, it is mapped to the address space

LoadModule included in a Windows application, and in the
designated environment running

MsgWaitForMultipleObjects waiting a single object or a
series of target signal. If the conditions for return have
been met, then immediately return to

SetPriorityClass the process of setting a priority level

SetProcessShutdownParameters the system shut down during the
process of setting designated him as opposed to other
procedures for the closure of the order

SetProcessWorkingSetSize operating system set to the actual
demarcation process used memory capacity

SetThreadPriority set of thread-level priority

ShellExecute to find documents associated with the specified
procedure with the file name

TerminateProcess the end of a process

WinExec designated to run the program

12. API of control and information functions

AdjustWindowRect given a window style, calculated to obtain
the required target area of the rectangular window size

AnyPopup screen to determine if there is any pop-up window

ArrangeIconicWindows arranged a window of the Father of the
smallest window annihilator

AttachThreadInput connecting thread input function

BeginDeferWindowPos start to build a series of new window
location of the course

BringWindowToTop will be designated by the window with a
window to the top of the list

CascadeWindows to stack arranged window

ChildWindowFromPoint return to the parent window that
contains the designated point of the first sub-window handle

ClientToScreen window in order to determine customer area
that coordinates the screen coordinates of a point

CloseWindow minimize designated by the window
Copy the contents of the rectangular CopyRect

The function to DeferWindowPos specific window of a
specified location of the new window

DestroyWindow designated by the window as well as the
removal of all its sub-window

DrawAnimatedRects described a series of dynamic rectangular

EnableWindow designated by the window to allow or prohibit
all mouse and keyboard input
At the same time EndDeferWindowPos update DeferWindowPos

call all the time specified the location and status window

EnumChildWindows designated as the father of the child
window enumeration window

EnumThreadWindows designated with the task of enumeration of
the relevant window

EnumWindows window enumerated a list of all the parent
window

EqualRect two rectangular structures to determine whether or
not the same

FindWindow to find the list of the first window to meet
prescribed conditions of top-level window

FindWindowEx window in the list and look for designated
conditions in line with the first sub-window

FlashWindow showed flashes designated window

GetActiveWindow access to the activities of the window
handle

GetCapture get a handle of the window, enter the window at
the current thread, and have the mouse Capture (to receive
it by the mouse)

GetClassInfo made WNDCLASS structure (or structure
WNDCLASSEX) a copy of the structure and included in the
designated categories of information relating to

GetClassLong window made of a type of variable Long entry

GetClassName designated as a window to obtain class name

GetClassWord window for the type of access to a whole number
variable

GetClientRect window to return to designated customers
rectangular area the size of the

GetDesktopWindow was on behalf of the entire screen of a
window (desktop window) handle

GetFocus have access to enter the focus of the window handle

GetForegroundWindow access to the front window handle

GetLastActivePopup was the father of a given window over the
recent activation of the pop-up window handle

GetParent judge designated window of the father of window

GetTopWindow internal search window list to find the first
part of the designated window handle of a window

GetUpdateRect a rectangle, it describes a designated window
of the need to update that part of the

GetWindow a window handle of the window and the window there
is a particular source of a relationship

GetWindowContextHelpId made with the window associated with
the scene to help ID

GetWindowLong from a designated window in the structure of
access to information

GetWindowPlacement window was designated a state and
location information

GetWindowRect access to the entire scope of the rectangular
window, the window frame, the title bar, scroll bar menu and
so on in this rectangle with

GetWindowText to obtain a form of title (caption) text, or
control the content of a

GetWindowTextLength to investigate the title of the text
window or control the content of the length of

GetWindowWord was designated window of the structure of the
information

InflateRect increase or decrease the size of a rectangular

IntersectRect this function in lpDestRect loaded in a
rectangle, it is lpSrc1Rect and lpSrc2Rect the intersection
of the two rectangular

InvalidateRect shielding a window of the customer area in
whole or in part the region

IsChild to determine whether a window to another window or
attached to the sub-window

IsIconic to determine whether the window had been minimized

IsRectEmpty to determine whether a rectangular space

IsWindow a window handle to determine the validity of

IsWindowEnabled to determine whether the window is active

IsWindowUnicode a window to determine whether the Unicode
window. This means that the window for text-based news All
are to receive Unicode characters

IsWindowVisible to determine whether the window can be seen

IsZoomed to determine whether or not to maximize the window

LockWindowUpdate lock designated window, it is prohibited to
update

MapWindowPoints a window client coordinates of the area's
window-point conversion to another area of customer
coordinate system

MoveWindow to change the designation of the location and
size of the window

OffsetRect through the application of a specified shift, so
that the rectangle moving up

OpenIcon to restore a minimum of procedure, and activation

PtInRect to determine whether or not at the designated
points within the rectangular

RedrawWindow redraw all or part of the window

ReleaseCapture current application for the release of
captured mouse

ScreenToClient judge on the screen of a customer's
designated point coordinates of the area

ScrollWindow rolling window of the customer area, in whole
or in part
According to the ScrollWindowEx additional option, customers
rolling window area in whole or in part

SetActiveWindow activated designated by the window

SetCapture will catch the mouse to a specific set of window

SetClassLong window-type setting for a Long variable entry

SetClassWord window-type setting for an entry

SetFocusAPI input will be the focus located at a designated
window. If necessary, will be activated window

SetForegroundWindow window to the front window as the system

SetParent designate a new window of the Father

SetRect rectangle designated set of content

SetRectEmpty will be set to an empty rectangle rectangular

SetWindowContextHelpId designated as a window to help set
the scene (context) ID
Structures SetWindowLong in the window as the designated
window set up information

SetWindowPlacement set up a state window and location
information

SetWindowPos window to specify a new location and status

SetWindowText set the window title of the text or control
the content of

SetWindowWord window in the structure of the window to
specify the information

ShowOwnedPopups to show or hide all windows specified by all
the pop-up window

ShowWindow control window visibility

ShowWindowAsync with similar ShowWindow
SubtractRect loading rectangular lprcDst, it is rectangular
in lprcSrc1 subtracted lprcSrc2 results

TileWindows flat to order window

UnionRect loaded with a rectangular lpDestRect goal, which
is lpSrc1Rect and lpSrc2Rect together the results of

UpdateWindow mandatory update window
Check window ValidateRect all or part of the customer area

WindowFromPoint include the return of the designated point
of the window handle. Shield ignored, hidden, as well as a
transparent window .

[دلفــي]

{ ======================================= }
{ Convert a HexString value to an Int64 }
{ Note : Last Char can be 'H' for Hex }
{ eg. '00123h' or '00123H' }
{ 0 will be returned if invalid HexString }
{ ======================================= }

function HexToInt(HexStr : string) : Int64;
var RetVar : Int64;
i : byte;
begin
HexStr := UpperCase(HexStr);
if HexStr[length(HexStr)] = 'H' then
Delete(HexStr,length(HexStr),1);
RetVar := 0;

for i := 1 to length(HexStr) do begin
RetVar := RetVar shl 4;
if HexStr[i] in ['0'..'9'] then
RetVar := RetVar + (byte(HexStr[i]) - 48)
else
if HexStr[i] in ['A'..'F'] then
RetVar := RetVar + (byte(HexStr[i]) - 55)
else begin
Retvar := 0;
break;
end;
end;

Result := RetVar;
end;

{ ============================================== }
{ Convert an Int64 value to a binary string }
{ NumBits can be 64,32,16,8 to indicate the }
{ return value is to be Int64,DWord,Word }
{ or Byte respectively (default = 64) }
{ NumBits normally are only required for }
{ negative input values }
{ ============================================== }

function IntToBin(IValue : Int64; NumBits : word = 64) : string;
var RetVar : string;
i,ILen : byte;
begin
RetVar := '';

case NumBits of
32 : IValue := dword(IValue);
16 : IValue := word(IValue);
8 : IValue := byte(IValue);
end;

while IValue <> 0 do begin
Retvar := char(48 + (IValue and 1)) + RetVar;
IValue := IValue shr 1;
end;

if RetVar = '' then Retvar := '0';
Result := RetVar;
end;


{ ============================================== }
{ Convert a bit binary string to an Int64 value }
{ Note : Last Char can be 'B' for Binary }
{ eg. '001011b' or '001011B' }
{ 0 will be returned if invalid BinaryString }
{ ============================================== }

function BinToInt(BinStr : string) : Int64;
var i : byte;
RetVar : Int64;
begin
BinStr := UpperCase(BinStr);
if BinStr[length(BinStr)] = 'B' then Delete(BinStr,length(BinStr),1);
RetVar := 0;
for i := 1 to length(BinStr) do begin
if not (BinStr[i] in ['0','1']) then begin
RetVar := 0;
Break;
end;
RetVar := (RetVar shl 1) + (byte(BinStr[i]) and 1) ;
end;

Result := RetVar;
end;

[دلفــي]

تابع تبدیل تاریخ میلادی به هجری :





Function MiladiToHejri(GregorianDate : String;DateType : Integer) : String;
var
jmm, jdd : string;
g_days_in_month, j_days_in_month : array[0..11] of Integer;
HijriMonths : array[1..12] of String;
g_day_no, j_day_no, jy, jm, gy, gm : Longint;
j_np, i, jd, GD : Integer;
flag : Boolean;
begin
flag := true;
g_days_in_month[0] := 31;
g_days_in_month[1] := 28;
g_days_in_month[2] := 31;
g_days_in_month[3] := 30;
g_days_in_month[4] := 31;
g_days_in_month[5] := 30;
g_days_in_month[6] := 31;
g_days_in_month[7] := 31;
g_days_in_month[8] := 30;
g_days_in_month[9] := 31;
g_days_in_month[10] := 30;
g_days_in_month[11] := 31;


j_days_in_month[0] := 31;
j_days_in_month[1] := 31;
j_days_in_month[2] := 31;
j_days_in_month[3] := 31;
j_days_in_month[4] := 31;
j_days_in_month[5] := 31;
j_days_in_month[6] := 30;
j_days_in_month[7] := 30;
j_days_in_month[8] := 30;
j_days_in_month[9] := 30;
j_days_in_month[10] := 30;
j_days_in_month[11] := 29;


If GregorianDate = Null Then Exit;
ShortDateFormat := 'yyyy/mm/dd';
gy := (StrToInt(GregorianDate[1]+GregorianDate[2]+GregorianDate[3]+GregorianDate[4]) - 1600) ;
gm := (StrToInt(GregorianDate[6]+GregorianDate[7]) - 1) ;
GD := (StrToInt(GregorianDate[9]+GregorianDate[10]) - 1) ;


g_day_no := 365 * gy + (gy + 3) div 4 - (gy + 99) div 100 + ( gy + 399) div 400;
i := 0;
While i < gm do
begin
g_day_no := g_day_no + g_days_in_month[i];
i := i + 1;
end;


If (gm > 1) And (((gy Mod 4 = 0) And (gy Mod 100 <> 0)) Or (gy Mod 400 = 0)) Then
g_day_no := g_day_no + 1;


g_day_no := g_day_no + GD;
j_day_no := g_day_no - 79;
j_np := j_day_no div 12053;
j_day_no := j_day_no Mod 12053;
jy := 979 + 33 * j_np + 4 * (j_day_no div 1461);
j_day_no := j_day_no Mod 1461;


If (j_day_no >= 366) Then
begin
jy := jy + ((j_day_no - 1) div 365);
j_day_no := (j_day_no - 1) Mod 365;
End;
i := 0;
While (j_day_no >= j_days_in_month[i]) and flag do
begin
j_day_no := j_day_no - j_days_in_month[i];
i := i + 1;
If i > 12 Then
begin
i := 11;
j_day_no := 29;
flag := False;
End;
end;
jm := i + 1;
jd := j_day_no + 1;
jmm := IntToStr(jm);
jdd := IntToStr(jd);
If (Length(jmm) = 1) then
jmm := '0' + jmm
else
jmm := jmm;
if (Length(jdd) = 1) then
jdd := '0' + jdd
else
jdd := jdd;


HijriMonths[1] := 'فروردين';
HijriMonths[2] := 'ارديبهشت';
HijriMonths[3] := 'خرداد';
HijriMonths[4] := 'تير';
HijriMonths[5] := 'مرداد';
HijriMonths[6] := 'شهريور';
HijriMonths[7] := 'مهر';
HijriMonths[8] := 'آبان';
HijriMonths[9] := 'آذر';
HijriMonths[10] := 'دي';
HijriMonths[11] := 'بهمن';
HijriMonths[12] := 'اسفند';
if jmm = '13' then
begin
jmm := '12';
jdd := '30';
end;
Case DateType of
0:
MiladiToHejri := IntToStr(jy) + '/' + jmm + '/' + jdd;
1:
MiladiToHejri := IntToStr(strtoint(jdd)) + ' ' + HijriMonths[StrToInt(jmm)] + ' ' + IntToStr(jy);
End;
End;







تابع تبدیل تاریخ هجری به میلادی :





Function HejriToMiladi(HejriDate : String;DateType : Integer) : String;
var
jy, jm, jd, Hd, Gd,y ,m, tmp, jmmm, jddd, jyyy : string;
c : Integer;
MiladiMonths : array[1..12] of String;
begin
jy := Copy(HejriDate,1,4);


jm := copy(HejriDate, 6, 2);
If (Length(jm) = 1) then
jm := '0' + jm
else
jm := jm;


jd := copy(HejriDate,9,2);
if (copy(jd,1,1) = '/' ) then
jd := '0' + copy(jd,2,1)
else
jd := jd;


HD := jy + '/' + jm + '/' + jd;
Case StrToInt(jm) of
1, 2, 3, 4, 5, 6, 7, 8, 9, 10 :
begin
m := IntToStr(StrToInt(jm) + 2);
Y := IntToStr(StrToInt(jy) + 621);
end;
11, 12 :
begin
m := '0' + copy(jm,2,1);
Y := IntToStr(StrToInt(jy) + 622);
end
End;//case
ShortDateFormat := 'yyyy/mm/dd';
GD := Y + '/' + m + '/01';
c := 0;
While True do
begin
tmp := GD;
If HD = MiladiToHejri(GD,0) Then
break;
GD := DateToStr(strtoDate(tmp)+ 1);
c := c + 1;
If c > 1000 Then
begin
HejriToMiladi := 'تاريخ وارد شده اشتباه مي باشد . ';
Exit;
end;
end;//while


MiladiMonths[1] := 'January';
MiladiMonths[2] := 'February';
MiladiMonths[3] := 'March';
MiladiMonths[4] := 'April';
MiladiMonths[5] := 'May';
MiladiMonths[6] := 'June';
MiladiMonths[7] := 'July';
MiladiMonths[8] := 'August';
MiladiMonths[9] := 'September';
MiladiMonths[10] := 'October';
MiladiMonths[11] := 'November';
MiladiMonths[12] := 'December';
Case DateType of
0:
HejriToMiladi := GD;
1:
begin
jyyy := copy(GD,1,4);
jmmm := copy(GD,6,2);
if (copy(jmmm,2,1) = '/' ) then
jmmm := '0' + copy(jmmm,1,1)
else
jmmm := jmmm;
jddd := copy(GD,Length(GD)-1,2);
if (copy(jddd,1,1) = '/' ) then
jddd := '0' + copy(jddd,2,1)
else
jddd := jddd;
HejriToMiladi := jyyy + ' ' + MiladiMonths[StrToInt(jmmm)] + ' ' + IntToStr(strtoint(jddd));
end;
End;
End;

[دلفــي]

function WinToDosStr(WinStr:string):string;
var Nflag:boolean;
Ch:Char;
T,N,M,I,J,DosI:integer;
TmpStr,Str1,Str2:String;
DosSt:String;
begin
DosSt:=''; WinStr:=WinStr+' '; M:=length(WinStr);
for I:=1 to M do
DosSt:=DosSt + #32;
DosI:=M; Str1:='';
for I:=1 To M do
begin
Nflag:=False;
case WinStr[i] Of
' ' :Begin
Ch:=#32;
end;
'.','0' .. '9'
: begin
Ch:=chr(ord(WinStr[i])+80);
if (WinStr[i])='.' then
ch:=#140;
str1:=str1+ch;
Nflag:=true;
ch:=#0;
end;
'a' .. 'z',
'A' .. 'Z'
: begin
Ch:=WinStr[i];
str1:=str1+ch;
Nflag:=true;
ch:=#0;
end;
'آ' :begin
ch:=#141;
end;
'ئ' :Begin
Ch:=#142;
end;
'ء' :Begin
Ch:=#143;
end;
'ا' :begin
Ch:=#145;
if((WinStr[i-1]=' ')or
(WinStr[i-1]=#157)or
(WinStr[i-1]='ا')or
(WinStr[i-1]='و')or
(WinStr[i-1]='د')or
(WinStr[i-1]='ذ')or
(WinStr[i-1]='ر')or
(WinStr[i-1]='ز')or
(WinStr[i-1]='ژ')or
(i=1 )
)
then
ch:=#144;
end;
'ب' : begin
Ch:=#147;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
Ch:=#146;
end;
'پ' : begin
Ch:=#149;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
Ch:=#148;
end;
'ت' :begin
Ch:=#151;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
Ch:=#150;
end;
'ث' :begin
Ch:=#153;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#152
end;
'ج' :begin
Ch:=#155;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#154
end;
'چ' :begin
Ch:=#157;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#156;
end;
'ح' :begin
Ch:=#159;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#158;
end;
'خ' :begin
Ch:=#161;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#160;
end;
'د' :begin
Ch:=#162;
end;
'ذ' :begin
Ch:=#163;
end;
'ر' :begin
Ch:=#164;
end;
'ز' :begin
Ch:=#165;
end;
'ژ' :begin
Ch:=#166;
end;
'س' :begin
Ch:=#168;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
Ch:=#167;
end;
'ش' :begin
Ch:=#170;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#169;
end;
'ص' :begin
Ch:=#172;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#171;
end;
'ض' :begin
Ch:=#174;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#173;
end;
'ط' :begin
ch:=#175 ;
end;
'ظ' :begin
ch:=#224
end;
'ع' :begin
Ch:=#227;
if((WinStr[i-1]=' ')or
(WinStr[i-1]=#157)or
(WinStr[i-1]='ا')or
(WinStr[i-1]='و')or
(WinStr[i-1]='د')or
(WinStr[i-1]='ذ')or
(WinStr[i-1]='ر')or
(WinStr[i-1]='ز')or
(WinStr[i-1]='ژ')or
(i=1) )
then
ch:=#228;
if ((WinStr[i+1]=' ') or (i=M)) then
if (ch=#228) then
ch:=#225
else
ch:=#226;
end;
'غ' :begin
Ch:=#231;
if((WinStr[i-1]=' ')or
(WinStr[i-1]=#157)or
(WinStr[i-1]='ا')or
(WinStr[i-1]='و')or
(WinStr[i-1]='د')or
(WinStr[i-1]='ذ')or
(WinStr[i-1]='ر')or
(WinStr[i-1]='ز')or
(WinStr[i-1]='ژ')or
(i=1) )
then
ch:=#232;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
if (ch=#232) then
ch:=#229
else
ch:=#230;
end;
'ف' :begin
Ch:=#234;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#233;
end;
'ق' :begin
Ch:=#236;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#235;
end;
'ك' :begin
Ch:=#238;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#237;
end;
'گ' :begin
Ch:=#240;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#239 ;
end;
'ل' :begin
Ch:=#243;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#241;
end;
'م' :begin
Ch:=#245;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ') or (WinStr[i+1]='آ')) then
ch:=#244;
end;
'ن' :begin
Ch:=#247;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#246;
end;
'و' :begin
ch:=#248 ;
end;
'ه' :begin
Ch:=#250;
if((WinStr[i-1]=' ')or(WinStr[i-1]=#157)or(WinStr[i-1]='ا')or(WinStr[i-1]='و')or
(WinStr[i-1]='د')or(WinStr[i-1]='ذ')or(WinStr[i-1]='ر')or(WinStr[i-1]='ز')or
(WinStr[i-1]='ژ')or(i=1))
then
ch:=#251;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#249;
end;
'ي' :begin
Ch:=#254;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#252;
if (ord(WinStr[i])=236)then
Ch:=#254;
end;
'ـ' :begin
ch:=#139 ;
end;
else
ch:=WinStr[i];
end;


if (Nflag=false) and(ch<>#0) and (DosI>0 )then
begin
N:=length(str1);
for j:=N downto 1 do
if (WinStr[i]<>#157) then
begin
DosSt[DosI]:=str1[j];
Dec(DosI);
end;


if (WinStr[i]<>#157) then
begin
DosSt[DosI]:=Ch; Dec(DosI);
end;


str1:='';
end;
end;
if (Nflag=True) and(ch=#0) and (DosI>0 )then
begin
N:=length(str1);
for j:=N downto 1 do
begin
DosSt[DosI]:=str1[j];
Dec(DosI);
end;
end;
WinToDosStr:=copy(DosSt,2,length(DosSt));
end;

[دلفــي]

Function IsNumber(Str : String) : Boolean;
Var
I, Code : Integer;
Begin
Val(Str, I, Code);
if Code <> 0 Then
Begin
MessageDlg(' خطا در موقعيت : ' + Inttostr(Code), MtWarning, [mbOk], 0);
Code := Code + I;
IsNumber := False;
End
Else
IsNumber := True;
End;

[دلفــي]

FUNCTION CHAR_CONTROL(Sender: STRING):STRING;
Var ch_check, ch_check2 : String;
i_check : integer;
begin
ch_check:=SENDER;
i_check:=0;
if sender='' then
exit;
ch_check2:='';
WHILE i_check<=LENGTH(ch_check) DO
BEGIN
IF ch_check[i_check]='&' THEN
BEGIN
i_check:= i_check+6;
ch_check2:= ch_check2+'ي';
END
ELSE
IF ch_check[i_check]='ک' THEN
ch_check2:= ch_check2+'ك'
ELSE
ch_check2:= ch_check2+ ch_check[i_check];
i_check:= i_check+1;
END;
i_check:=2;
ch_check:='';
WHILE i_check<=LENGTH(ch_check2) DO
BEGIN
ch_check:= ch_check+ ch_check2[i_check];
i_check:= i_check+1;
END;
Result:= ch_check;
END;

[دلفــي]

unit NumberToString;

interface
uses SysUtils;

const
yekan : array[0..9] of string = ('صفر','يک','دو','سه','چهار','پنج' ,'شش','هفت','هشت','نه');
dahgan : array[0..9] of string = ('','','بيست','سي','چهل','پنجاه','ش صت','هفتاد','هشتاد','نود');
dahyek : array[10..19] of string = ('ده','يازده','دوازده','سيزده',' چهارده','پانزده','شانزده','هف� �ه','هجده','نوزده');
sadgan : array[0..9] of string = ('','يکصد','دويست','سيصد','چهارص د','پانصد','ششصد','هفتصد','هشتص د','نهصد');
base : array[0..4] of string = ('','هزار','ميليون','ميليارد','ت ريليون');

function AddComma(snum : string) : string;
function GetStr(snum : string) : string;

implementation

// تابع اعتبار سنجي عدد
function isvalid15(snum : string) : boolean;
var
i, l : integer;
b : boolean;
begin
b := true;
l := length(snum);
if l > 15 then
b := false
else
for i := 1 to l do
if not(snum[i] in ['0'..'9']) then
b := false;
result := b;
end;

// تابع تبديل عدد به حروف
function num2str(snum : string) : string;
// تابع تبد?ل عدد سه رقم? به حروف
function getnum3(num3 : integer) : string;
var
s : string;
d1, d2, d3, d12 : integer;
begin
d12 := num3 mod 100; // دو رقم اول
d3 := num3 div 100; // صدگان
if d3 <> 0 then
s := sadgan[d3] + ' و ';
// نام گذاري اعداد 10 تا 19 در بين
// اعداد دو رقمي استثنا است
if (d12 >= 10) and (d12 <= 19) then
begin
s := s + dahyek[d12];
end
else
begin
d2 := d12 div 10; // دهگان
if d2 <> 0 then
s := s + dahgan[d2] + ' و ';
d1 := d12 mod 10; // يکان
if d1 <> 0 then
s := s + yekan[d1] + ' و ';
// حذف حرف <و> اضافي
s := copy(s, 1, length(s) - 3);
end;
getnum3 := s;
end;

var
L, i, b : integer;
stotal : string;
begin
// اگر عدد صفر بود، يکراست نتيجه را برگردان
if snum = '0' then
result := yekan[0]
else
begin
// براي اينکه بتوان عدد را به قسمت هاي سه رقمي تقسيم کرد
// به سمت چپ عدد، به اندازه کافي صفر مي افزاييم
for i := Length(snum) to ((Length(snum) - 1) div 3 + 1) * 3 - 1 do
snum := '0' + snum;

L := Length(snum) div 3 - 1; // تعداد قسمت هاي سه رقمي منهاي يک

// سه رقم سه رقم حلقه را تکرار کن
// از چپ به راست
for i := 0 to L do
begin
// به دست آوردن سه رقم مورد نظر
b := strtoint(copy(snum ,i * 3 + 1, 3));
// اگر سه رقم به دست آمده صفر باشد، در نام عدد تاثيري ندارد
// نام قسمت سه رقمي را بدست مي آوريمgetnum3 با استفاده از تابع
// پسوند را به آن اضافه مي کنيمbase با استفاده از آرايه
if b <> 0 then
stotal := stotal + getnum3(b) + ' ' + base[L - i] + ' و ';
end;
// حذف حرف <و> اضافي
stotal := copy(stotal, 1, length(stotal) - 3);
result := stotal;
end;
end;

// اين تابع، يک لايه براي تابع <تبديل عدد به حروف> است که صحت مقدار ورودي را نيز بررسي مي کند
function GetStr(snum : string) : string;
begin
snum := trim(snum);
if isvalid15(snum) then
result := num2str(snum)
else
result := 'عدد مورد نظر بسيار بزرگ است و يا معتبر نيست' ;
end;

// *****************************
// *****************************
// *****************************
// تابع افزودن ويرگول
// اين تابع يک عدد مي گيرد و به ازاي هر سه رقم يک ويرگول بين اعداد قرار مي دهد
function AddComma(snum : string) : string;
var
l, i : integer;
s : string;
begin
i := 1;
l := length(snum);
while i <= l do
begin
s := snum[l - i + 1] + s;
if (i mod 3 = 0) and (i <> l) then
s := ',' + s;
i := i + 1;
end;
result := s;
end;

end.

[h_mohamadi]

سلام اين Delphi_Win32_Shell_API چرا پارت 6 را ندارد و ضميمه هم دانلود نمي شود

[khoshblagh]

function WinToDosStr(WinStr:string):string;
var Nflag :boolean;
Ch : Char;
T,N,M,I,J,DosI :integer;
TmpStr,Str1,Str2 :String;
DosSt :String;
begin
DosSt:='';
WinStr:=WinStr+' ';
M:=length(WinStr);
for I:=1 to M do
DosSt:=DosSt + #32;
DosI:=M;
Str1:='';
for I:=1 To M do
begin
Nflag:=False;
case WinStr[i] Of
' ' :Begin
Ch:=#32;
end;


'.','0' .. '9'
: begin
Ch:=chr(ord(WinStr[i])+80);
if (WinStr[i])='.' then
ch:=#140;
str1:=str1+ch;
Nflag:=true;
ch:=#0;
end;
'a' .. 'z',
'A' .. 'Z'
: begin
Ch:=WinStr[i];
str1:=str1+ch;
Nflag:=true;
ch:=#0;
end;
'آ' :begin
ch:=#141;
end;
'ئ' :Begin
Ch:=#142;
end;
'ء' :Begin
Ch:=#143;
end;
'ا' :begin
Ch:=#145;
if((WinStr[i-1]=' ')or
(WinStr[i-1]=#157)or
(WinStr[i-1]='ا')or
(WinStr[i-1]='و')or
(WinStr[i-1]='د')or
(WinStr[i-1]='ذ')or
(WinStr[i-1]='ر')or
(WinStr[i-1]='ز')or
(WinStr[i-1]='ژ')or
(i=1 )
)
then
ch:=#144;
end;
'ب' : begin
Ch:=#147;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
Ch:=#146;
end;
'پ' : begin
Ch:=#149;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
Ch:=#148;
end;
'ت' :begin
Ch:=#151;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
Ch:=#150;
end;
'ث' :begin
Ch:=#153;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#152
end;
'ج' :begin
Ch:=#155;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#154
end;
'چ' :begin
Ch:=#157;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#156;
end;
'ح' :begin
Ch:=#159;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#158;
end;
'خ' :begin
Ch:=#161;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#160;
end;
'د' :begin
Ch:=#162;
end;
'ذ' :begin
Ch:=#163;
end;
'ر' :begin
Ch:=#164;
end;
'ز' :begin
Ch:=#165;
end;
'ژ' :begin
Ch:=#166;
end;
'س' :begin
Ch:=#168;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
Ch:=#167;
end;
'ش' :begin
Ch:=#170;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#169;
end;
'ص' :begin
Ch:=#172;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#171;
end;
'ض' :begin
Ch:=#174;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#173;
end;
'ط' :begin
ch:=#175 ;
end;
'ظ' :begin
ch:=#224
end;
'ع' :begin
Ch:=#227;
if((WinStr[i-1]=' ')or
(WinStr[i-1]=#157)or
(WinStr[i-1]='ا')or
(WinStr[i-1]='و')or
(WinStr[i-1]='د')or
(WinStr[i-1]='ذ')or
(WinStr[i-1]='ر')or
(WinStr[i-1]='ز')or
(WinStr[i-1]='ژ')or
(i=1) )
then
ch:=#228;
if ((WinStr[i+1]=' ') or (i=M)) then
if (ch=#228) then
ch:=#225
else
ch:=#226;
end;
'غ' :begin
Ch:=#231;
if((WinStr[i-1]=' ')or
(WinStr[i-1]=#157)or
(WinStr[i-1]='ا')or
(WinStr[i-1]='و')or
(WinStr[i-1]='د')or
(WinStr[i-1]='ذ')or
(WinStr[i-1]='ر')or
(WinStr[i-1]='ز')or
(WinStr[i-1]='ژ')or
(i=1) )
then
ch:=#232;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
if (ch=#232) then
ch:=#229
else
ch:=#230;


end;
'ف' :begin
Ch:=#234;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#233;
end;
'ق' :begin
Ch:=#236;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#235;
end;
'ك' :begin
Ch:=#238;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#237;
end;
'گ' :begin
Ch:=#240;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#239 ;
end;
'ل' :begin
Ch:=#243;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#241;
end;
'م' :begin
Ch:=#245;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ') or (WinStr[i+1]='آ')) then
ch:=#244;
end;
'ن' :begin
Ch:=#247;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#246;
end;
'و' :begin
ch:=#248 ;
end;
'ه' :begin
Ch:=#250;
if((WinStr[i-1]=' ')or
(WinStr[i-1]=#157)or
(WinStr[i-1]='ا')or
(WinStr[i-1]='و')or
(WinStr[i-1]='د')or
(WinStr[i-1]='ذ')or
(WinStr[i-1]='ر')or
(WinStr[i-1]='ز')or
(WinStr[i-1]='ژ')or
(i=1 ))
then
ch:=#251;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#249;
end;
'ي' :begin
Ch:=#254;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#252;
if (ord(WinStr[i])=236)then
Ch:=#254;
end;
'ـ' :begin
ch:=#139 ;
end;
else
ch:=WinStr[i];
end;


if (Nflag=false) and(ch<>#0) and (DosI>0 )then
begin
N:=length(str1);
for j:=N downto 1 do
if (WinStr[i]<>#157) then
begin
DosSt[DosI]:=str1[j];
Dec(DosI);
end;


if (WinStr[i]<>#157) then
begin
DosSt[DosI]:=Ch; Dec(DosI);
end;


str1:='';
end;
end;
if (Nflag=True) and(ch=#0) and (DosI>0 )then
begin
N:=length(str1);
for j:=N downto 1 do
begin
DosSt[DosI]:=str1[j];
Dec(DosI);
end;
end;


WinToDosStr:=copy(DosSt,2,length(DosSt));


end;



ضمن قدردانی از شما دوست گرامی در صورت امکان تبدیل رشته داس به ویندوز را هم
لطف کرده و در اختیار سایرین قرار دهید. در هر صورت متشکرم.

[دلفــي]

سلام اين Delphi_Win32_Shell_API چرا پارت 6 را ندارد و ضميمه هم دانلود نمي شود

حذف شده !!!

دوباره آپلود كردم .

40268

[دلفــي]

تانژانت:

function tan(num:extended):extended;
begin
tan:=sin(num)/cos(num);
end;

{------------------------------------------------------------------------------------}
کتانژانت:

function cot(num:extended):extended
begin
cot:=1/(sin(num)/cos(num));
end;


{------------------------------------------------------------------------------------}
ارک سینوس:

function arcsin(num:extended):extended;
begin
if num=1 then
arcsin:= arctan(1)*2
else
if num=-1 then
arcsin:=-(arctan(1)*2)

else
arcsin:=arctan(num/(sqrt(1-sqr(num))));
end;


{------------------------------------------------------------------------------------}
ارک کسینوس:

function arccos(num:extended):extended;
begin
if abs(num)=1 then
arccos:= arctan(1)*4*(1-num/abs(num))
else
arccos:=pi/2+arctan(-num/(sqrt(1-sqr(num))));
end;


{------------------------------------------------------------------------------------}
ارک کتانژانت :

function arccot(num:extended):extended;
begin
arccot:=-arctan(num)+pi/2;
end;


{------------------------------------------------------------------------------------}
سکانت:

function sec(num:extended):extended;
begin
sec:=1/cos(num);
end;


{------------------------------------------------------------------------------------}
کسکانت:

function csc(num:extended):extended;
begin
csc:= 1/sin(num);
end;


{------------------------------------------------------------------------------------}
ارک سکانت:

function arcsec(num:extended):extended;
begin
if abs(num)=1 then
arcsec := arctan(1) * (num/abs(num)) * 4
else
arcsec:=arctan(num/(sqrt(1-sqr(num))))+((num-1)/abs(num-1))*pi/2;
end;

{------------------------------------------------------------------------------------}
ارک کسکانت:

function arccsc(num:extended):extended;
begin
If abs(num) = 1 Then
arccsc := arctan(1) * (num/abs(num) * 4 - 2)
else
arccsc:= arctan(num/(sqrt(1-sqr(num))))+(num/abs(num)-1)*pi/2;
end;

[دلفــي]

// a به توان b
function Pow(a,b: Integer):Real;
begin
if b=0 then Pow := 1 else
Pow := a*Pow(a,b-1);
end;


// فاكتوريل
function Fact(n: Integer):Real;
begin
if n-1=1 then Fact := n else
Fact := n*Fact(n-1);
end;


// a ضربدر b
function Mul(a,b: Integer):Real;
begin
if b=1 then Mul := a else
Mul := a+Mul(a,b-1);
end;

[دلفــي]

procedure Delay(ms : longint);

var TheTime : LongInt; begin TheTime := GetTickCount + ms; while GetTickCount < TheTime do Application.ProcessMessages; end;

[h_mohamadi]

40846


سلام دوستان من این 6 تا فایل ‌Delphi_Win32_Shell_API را گرفتم اما extract نمی شود و پیغام زیر را می دهد.
ممنون می شوم من را راهنمایی کنید.

[دلفــي]

function MySplit(source : string; delimiter : string): TStringList;
var i : integer;
s : string;
arrString: TStringList;
begin
arrString := TStringList.Create;
s := ”;
i := 1;
repeat
begin
if Copy(source,i,Length(delimiter)) &lt;&gt; delimiter then
begin
s := s + Copy(source,i,1);
i := i + 1;
end
else
begin
arrString.Add(s);
s := ”;
i := i + Length(delimiter);
end;
end
until i &gt; Length(source);
if s &lt;&gt; ” then arrString.Add(s);
result := arrString;
end;

[دلفــي]

Function Description
ArcCos Inverse cosine
ArcCosh inverse cosine hyperbolicus
ArcCot inverse cotangens
ArcCoth inverse cotangens hyperbolicus
ArcCsc inverse cosecans
ArcCsch inverse cosecans hyperbolicus
ArcSec inverse secans
ArcSech inverse secans hyperbolicus
ArcSin inverse sine
ArcSinh inverse sine hyperbolicus
ArcTan inverse tangens
ArcTanh inverse tangens hyperbolicus
Arg complex number argument
Bigger Compare two complex numbers
Bigger2 Compare two complex number
CAbs absolute value
CartToPolar transform number from cartesian to polar coordinates
Ceil calculate ceiling of a number
CFrac calculate fractional part's of real and imaginary parts
Cos cosine
Cosh cosine hyperbolicus
Cot cotangens
Coth cotangens hyperbolicus
CRound round a complex number
Csc cosecans
Csch cosecans hyperbolicus
CSqr square of a complex number
CSqrt square root of a complex number
CTrunc truncate complex number
Equ are two numbers equal ?
Exp exponent (E^)
Exp10 exponent (10^)
Exp2 exponent (2^)
Expj Euler's equation
Fact calculate the N!
FixAngle set angle in -Pi,Pi interval
Floor the highest integer less than or equal to given number
Gamma calculate the gamma function
Gcd greatest common divisor
IntPower raise base to integer power
Lcm least common multiplier
Ln natural logarithm
LnGamma natural logarithm of gamma function
Log10 log base 10
Log2 log base 2
LogN log base N
Max compare two numbers and return maximum number
Min compare two numbers and return minimum number
Neg negate complex number
PolarToCart transform number from polar to cartesian coordinates
Power raise base to any power
Pythag calculate the sqrt(sqr(x)+sqr(y))
Rem calculate the remainder
Sec secant
Sech secant hyperbolicus
Sgn calculate signum of a number
Sin sine
SinCos calculate sine and cosine
Sinh sine hyperbolicus
SinhCosh calculate sine hyp. and cosine hyp.
Smaller compare two complex numbers
Smaller2 compare two complex numbers
Swap swap two numbers
Tan tangens
Tanh tangens hyperbolicus

[joker]

بعضی مواقع فقط زدن کلید تشکر کافی نیست :)

در مورد نرم افزاری که داریدتهیه میکنید پیشنهاد میکنم یک وب سایت مستقل آماده کنید که افراد به صورت آنلاین بتونند توابع را توضیحات فارسی براش بنوسید و همان موقع دیتابیس آن آپدیت شود
و مثلا هر ماه یکبار این دیتابیس در اختیار عموم قرار بگیرد.
کار به این روش خیلی سریع ، راحت و خوب پیش میره....
اگه احیانا تصمیم به این کار گرفتید یکسری ریزه کاری هم هست که میگم اگه رعایت بشه یک مرجع خیلی خوب برای همه برنامه نویسان دلفی میشه ...

برای ترجمه سریع هم از گوگل ترانسلیتور استفاده شد:

[دلفــي]

در مورد نرم افزاری که داریدتهیه میکنید پیشنهاد میکنم یک وب سایت مستقل آماده کنید که افراد به صورت آنلاین بتونند توابع را توضیحات فارسی براش بنوسید و همان موقع دیتابیس آن آپدیت شود
و مثلا هر ماه یکبار این دیتابیس در اختیار عموم قرار بگیرد.


دوست گرامي در برنامه اي كه در دست تهيه است از پايگاه داده استفاده نشده است ، در ضمن توابع دلفي كه هر يك ماه يك بار اضافه نمي شوند تا ما هم هر يك ماه آن را آپديت كنيم ! اگر هم نيازي به آپديت باشد در خود برنامه اعمال شده و در اختيار دوستان قرار مي گيرد چون خود برنامه داراي حجم چنداني نخواهد بود .



برای ترجمه سریع هم از گوگل ترانسلیتور استفاده شد


مترجم گوگل جملات را به صورت تك كلمه اي ترجمه مي كند و در كل جمله معناي مورد نظر را نمي دهد و چون اكثر واژه هاي به كار برده شده در توضيحات اختصاصي هستند پس بايد به صورت جمله به جمله و دستي ترجمه شوند ، در ضمن كيفت كار هم زمين تا آسمان باهم فرق مي كند .

اين چند خط اول از ترجمه شماست ، خودتان قضاوت كنيد آيا كسي كه در ابتداي راه براي كار با دلفي است از اين توضيحات چيزي متوجه مي شود ؟!


مي دهد ارزش مطلق عدد (- Vê امضاء حذف شده)
مي دهد که آدرس يک متغير ، تابع يا روال
مقايسه دو رشته براي برابري ، مورد چشم پوشي کردن
نقل درست اگر يک رشته شامل يک کلمه زير رشته
نقل درست اگر يک رشته شامل يک کلمه زير رشته ، مورد بي اعتنا
نقل درست به پايان مي رسد اگر يک رشته با زير رشته
مقايسه يک رشته با يک ليست از رشته ها -- برمي گرداند کليدي صفحه اول
.
.
.

[joker]

به نظر من
1-دیتابیسیش کنید که بعداز مدتی که تکمیل شد یکجا و راحت قابل استفاده باشد
برای این گفتم آنلاین و دیتابیسی که هرکسی در هر زمانی( هر وقت حس و حالشو داشت ) بشینه آپدیت کنه
2- گوگل مترجم سریع و البته دارای عیب و نقص است ، میشه یکبار داد به گوگل و بعد کمی ویرایش کرد مطمئنن ویرایش ساده تر از ترجمه کل هست
3- میتونید هم هیچکدوم از این کارهایی که گفتم را نکنید :)

[vcldeveloper]

1-دیتابیسیش کنید که بعداز مدتی که تکمیل شد یکجا و راحت قابل استفاده باشد
برای این گفتم آنلاین و دیتابیسی که هرکسی در هر زمانی( هر وقت حس و حالشو داشت ) بشینه آپدیت کنه
برای این کار کافی هست که یک دامین داشته باشید، با فضای معین، و یک Wiki روی آن نصب کنید.

[دلفــي]

با تشكر از نظرات سودمند دوستان عزيز ، با توجه به درخواست دوستان سعي ميكنم از پايگاه داده براي نگهداري و ثبت اطلاعات جديد استفاده كنم و به پيشنهاد دوستان عمل خواهم كرد.

در ضمن برنامه در اواخر مراحل اتمام كار است و به زودي براي علاقه مندان ارائه مي شود ، البته هنوز ترجمه كاملي براي من ارسال نشده است به جزء ترجمه اي كه كاربر Mahmood_N برايم ارسال كرده بود كه قسمتهايي از اون بدون ترجمه باقي مونده بود، با اين حال واقعا دستشان درد نكنه !

من فايلي رو كه ايشون برام ارسال كردند رو همينجا آپلود ميكنم تا بقيه عزيزان اگه امكانش رو داشتند قسمتهاي ناقص رو كاملش كنند .

اين هم تصوير محيط برنامه :

http://img37.imagefra.me/img/img37/1/12/9/yalanemail/f_e7im_08a2559.jpg

[دلفــي]

ضمن قدردانی از شما دوست گرامی در صورت امکان تبدیل رشته داس به ویندوز را هم
لطف کرده و در اختیار سایرین قرار دهید. در هر صورت متشکرم.

قبلا دوستان زحمتش رو كشيدن :

http://www.barnamenevis.org/forum/downloads.php?do=file&id=26

[دلفــي]

Function Byte2Word(hbyte:Byte; lbyte:Byte): word;
var Temp: word;
begin
Temp := hbyte;
Temp := Temp shl 8;
Temp := Temp or lbyte;
Result := Temp;
end;

[دلفــي]

تابع Round به بالا :




Function RoundUp(Num : Real) :Real;
begin
SetRoundMode(rmUp);
RoundUp := RoundTo(Num,0);
end;


تابع Round به پايين :




Function RoundDown(Num : Real) :Real;
begin
SetRoundMode(rmDown);
RoundDown := RoundTo(Num,0);
end;

[دلفــي]

Function Sum(x,y:String):String;
// Programer: Alireza Talebi
var
S,S2,xi,yi:String;
Max:Integer;
i,n,Temp,x1,y1:integer;
begin
xi:='';
yi:='';
if StrLen(PChar(Trim(x))) >= StrLen(PChar(Trim(y))) then
begin
Max := StrLen(PChar(Trim(x)));
for i := 1 to Max - StrLen(PChar(Trim(y))) do
yi := yi + '0';
end else
begin
Max := StrLen(PChar(Trim(y)));
for i := 1 to Max - StrLen(PChar(Trim(x))) do
xi := xi + '0';
end;
xi := Trim(xi + x);
yi := Trim(yi + y);
S := '';
n := 0;
for i:= Max downto 1 do
begin
Temp:=0;
x1 := StrToInt(xi[i]);
y1 := StrToInt(yi[i]);
Temp:=x1+y1+n;
if Temp < 10 then begin
S := S + IntToStr(Temp);
n := 0;
end
else
begin
S := S + IntToStr(Temp mod 10);
n := 1;
end;
end;
S2 := '';
for i:= StrLen(PChar(Trim(S))) downto 1 do
S2 := S2 + S[i];
Sum := S2;
end;

[دلفــي]

function GetIdeSerialNumber(i:Integer) : String;
const IDENTIFY_BUFFER_SIZE = 512;
type
TIDERegs = packed record
bFeaturesReg : BYTE; // Used for specifying SMART "commands".
bSectorCountReg : BYTE; // IDE sector count register
bSectorNumberReg : BYTE; // IDE sector number register
bCylLowReg : BYTE; // IDE low order cylinder value
bCylHighReg : BYTE; // IDE high order cylinder value
bDriveHeadReg : BYTE; // IDE drive/head register
bCommandReg : BYTE; // Actual IDE command.
bReserved : BYTE; // reserved for future use. Must be zero.
end;
TSendCmdInParams = packed record
// Buffer size in bytes
cBufferSize : DWORD;
// Structure with drive register values.
irDriveRegs : TIDERegs;
// Physical drive number to send command to (0,1,2,3).
bDriveNumber : BYTE;
bReserved : Array[0..2] of Byte;
dwReserved : Array[0..3] of DWORD;
bBuffer : Array[0..0] of Byte; // Input buffer.
end;
TIdSector = packed record
wGenConfig : Word;
wNumCyls : Word;
wReserved : Word;
wNumHeads : Word;
wBytesPerTrack : Word;
wBytesPerSector : Word;
wSectorsPerTrack : Word;
wVendorUnique : Array[0..2] of Word;
sSerialNumber : Array[0..19] of CHAR;
wBufferType : Word;
wBufferSize : Word;
wECCSize : Word;
sFirmwareRev : Array[0..7] of Char;
sModelNumber : Array[0..39] of Char;
wMoreVendorUnique : Word;
wDoubleWordIO : Word;
wCapabilities : Word;
wReserved1 : Word;
wPIOTiming : Word;
wDMATiming : Word;
wBS : Word;
wNumCurrentCyls : Word;
wNumCurrentHeads : Word;
wNumCurrentSectorsPerTrack : Word;
ulCurrentSectorCapacity : DWORD;
wMultSectorStuff : Word;
ulTotalAddressableSectors : DWORD;
wSingleWordDMA : Word;
wMultiWordDMA : Word;
bReserved : Array[0..127] of BYTE;
end;
PIdSector = ^TIdSector;
TDriverStatus = packed record
// Error code from driver, or 0 if no error.
bDriverError : Byte;
// Contents of IDE Error register. Only valid when bDriverError is SMART_IDE_ERROR.
bIDEStatus : Byte;
bReserved : Array[0..1] of Byte;
dwReserved : Array[0..1] of DWORD;
end;
TSendCmdOutParams = packed record
// Size of bBuffer in bytes
cBufferSize : DWORD;
// Driver status structure.
DriverStatus : TDriverStatus;
// Buffer of arbitrary length in which to store the data read from the drive.
bBuffer : Array[0..0] of BYTE;
end;
var hDevice : THandle;
cbBytesReturned : DWORD;
SCIP : TSendCmdInParams;
aIdOutCmd : Array [0..(SizeOf(TSendCmdOutParams)+IDENTIFY_BUFFER_SIZE-1)-1] of Byte;
IdOutCmd : TSendCmdOutParams absolute aIdOutCmd;
procedure ChangeByteOrder( var Data; Size : Integer );
var ptr : PChar;
i : Integer;
c : Char;
begin
ptr := @Data;
for i := 0 to (Size shr 1)-1 do
begin
c := ptr^;
ptr^ := (ptr+1)^;
(ptr+1)^ := c;
Inc(ptr,2);
end;
end;
begin
Result := ''; // return empty string on error
if SysUtils.Win32Platform=VER_PLATFORM_WIN32_NT then // Windows NT, Windows 2000
begin
// warning! change name for other drives: ex.: second drive '\\.\PhysicalDrive1\'
hDevice := CreateFile( '\\.\PhysicalDrive0', GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0 );
end
else // Version Windows 95 OSR2, Windows 98
hDevice := CreateFile( '\\.\SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0 );
if hDevice=INVALID_HANDLE_VALUE then Exit;
try
FillChar(SCIP,SizeOf(TSendCmdInParams)-1,#0);
FillChar(aIdOutCmd,SizeOf(aIdOutCmd),#0);
cbBytesReturned := 0;
// Set up data structures for IDENTIFY command.
with SCIP do
begin
cBufferSize := IDENTIFY_BUFFER_SIZE;
// bDriveNumber := 0;
with irDriveRegs do
begin
bSectorCountReg := 1;
bSectorNumberReg := 1;
// if Win32Platform=VER_PLATFORM_WIN32_NT then bDriveHeadReg := $A0
// else bDriveHeadReg := $A0 or ((bDriveNum and 1) shl 4);
bDriveHeadReg := $A0;
bCommandReg := $EC;
end;
end;
if not DeviceIoControl( hDevice, $0007c088, @SCIP, SizeOf(TSendCmdInParams)-1,
@aIdOutCmd, SizeOf(aIdOutCmd), cbBytesReturned, nil ) then Exit;
finally
CloseHandle(hDevice);
end;
with PIdSector(@IdOutCmd.bBuffer)^ do
begin
ChangeByteOrder( sSerialNumber, SizeOf(sSerialNumber) );
(PChar(@sSerialNumber)+SizeOf(sSerialNumber))^ := #0;
case i of
0: Result := PChar(@sModelNumber);
1: Result := PChar(@sSerialNumber);
2: Result := PChar(@sFirmwareRev);
end;
end;
end;


مثال :



procedure TForm1.BitBtn1Click(Sender: TObject);
begin
Edit1.Text := Trim(GetIdeSerialNumber(0));
Edit2.Text := Trim(GetIdeSerialNumber(1));
Edit3.Text := Trim(GetIdeSerialNumber(2));
end;

[دلفــي]

ChangeFileExt function
Changes the extension part of a string containing full path and file name.
ExcludeTrailingBackslash function
Removes '\' from the end of a string if it is there.
ExpandFileName function
Retrieves the full path and filename of a specified (relative) file.
ExpandUNCFileName function
Retrieves the full path and filename of a specified (relative) file using Universal Naming Convention for network files.
ExtractFileDir function
Returns only only directory or drive information parts of a string containing full path and file name.
ExtractFileDrive function
Returns only drive part of a string containing full path and file name.
ExtractFileName function
Returns only file name and extension parts of a string containing full path and file name.
ExtractFileExt function
Returns the extension part of a string containing full path and file name.
ExtractFilePath function
Returns the drive and directory parts of a string containing full path and file name.
ExtractShortPathName function
Returns 8.3 format for a given full path and file name.
MinimizeName function
Returns a shortened version of a filename (using dots for folders) that fits into some pixel length.
IncludeTrailingBackslash function
Adds '\' to the end of a string if it is not already there.
IsPathDelimiter function
Returns true if a specified character in a string is the backslash (\) character.
MatchesMask function
Returns True is a string value matches a format specifed by a mask.
ProcessPath procedure
Parses a full file name into its drive, path, and file name.

[دلفــي]

function ExistWordInString(aString:PWideChar;aSearchString: string;aSearchOptions: TStringSearchOptions): Boolean;
var
Size : Integer;
begin
Size:=StrLen(aString);
result := SearchBuf(aString, Size, 0, 0, aSearchString, aSearchOptions)<>nil;
end;

[دلفــي]

procedure AngleTextOut(ACanvas: TCanvas;Angle,X,Y: Integer;Str: string);
var
LogRec : TLogFont;
OldFontHandle,NewFontHandle :HFONT;
begin
GetObject(ACanvas.Font.Handle,SizeOf(LogRec),Addr( LogRec));
LogRec.lfEscapement := Angle * 10;
NewFontHandle := CreateFontIndirect(LogRec);
OldFontHandle := SelectObject(ACanvas.Handle,NewFontHandle);
ACanvas.TextOut(X,Y,str);
NewFontHandle := SelectObject(ACanvas.Handle,OldFontHandle);
DeleteObject(NewFontHandle);
end;


مثال :



AngleTextOut(Form1.Canvas,12,10,65,'Programer: Alireza Talebi!!'

[دلفــي]

function KillApp(const Name: PChar) : boolean;
var AppHandle:THandle;
begin
AppHandle:=FindWindow(Nil, Name) ;
Result:=PostMessage(AppHandle, WM_QUIT, 0, 0) ;
end;

[دلفــي]

توسط این کد می توانید تشخیص دهید که ویندوز چه مدت است که در حال اجراست



function UpTime: string;
const
ticksperday: Integer = 1000 * 60 * 60 * 24;
ticksperhour: Integer = 1000 * 60 * 60;
ticksperminute: Integer = 1000 * 60;
tickspersecond: Integer = 1000;
var
t: Longword;
d, h, m, s: Integer;
begin
t := GetTickCount;
d := t div ticksperday;
Dec(t, d * ticksperday);
h := t div ticksperhour;
Dec(t, h * ticksperhour);
m := t div ticksperminute;
Dec(t, m * ticksperminute);
s := t div tickspersecond;
Result := 'Uptime: ' + IntToStr(d) + ' Days ' + IntToStr(h) +
' Hours ' + IntToStr(m) + ' Minutes ' + IntToStr(s) + ' Seconds';
end;
//Sample
procedure TForm1.Button1Click(Sender: TObject);
begin
label1.Caption := UpTime;
end;

[دلفــي]

با استفاده از اين تابع می توانید زبان فارسی را به ویندوز اضافه کنید.در این کد دو فایل وجود دارد که باید در کنار همین برنامه قرار گیرد.(فایلها را می توانید در سی دی ویندوز پیدا کنید).



procedure AddFarsiLNG;
var Vreg:TRegistry;
begin

CopyFile('l_intl.nls','C:\windows\system32\l_intl. nls',true);
CopyFile('KBDFA.dll','C:\windows\system32\KBDFA.dl l',true);

Vreg:=TRegistry.Create;
with Vreg do
begin
try
RootKey:=HKEY_LOCAL_MACHINE;
OpenKey('HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlS et\Control\
Keyboard Layouts\00000429',true);
WriteString('Layout File','KBDFA.dll');
WriteString('Layout Text','Farsi');
OpenKey('HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlS et\Control\
Nls\Locale',true);
WriteString('d','1');
OpenKey('HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlS et\Control\
Nls\Language',true);
WriteString('0429','l_intl.nls');
CloseKey;
finally Free end;
end;
end;

[دلفــي]

من نرم افزار راهنماي توابع دلفي رو نوشتم و براي استفاده دوستان عزيز همينجا آپلود مي كنم ولي متاسفانه به دليل عنايت كم دوستان براي ترجمه توضيحات ، بنده مجبور شدم فقط از توضيحات انگليسي در برنامه استفاده كنم . (البته بازهم منتظر ترجمه عزيزاني كه دستي در ترجمه دارند هستم !)
اميدوارم مورد رضايت دوستداران دلفي قرار بگيرد .
با تشكر

[دلفــي]

با سلام:
پس از ارائه نسخه انگليسي نرم افزار راهنماي توابع دلفي با كمك برخي از دوستان تقريبا كار ترجمه توضيحات هم به پايان رسيده است و فقط 58 جمله مونده كه اون رو هم اگه از دوستان كسي كمك كنه و ترجمه كنه قسمت توضيحات فارسي رو هم به برنامه اضافه كرده و همينجا جهت استفاده ساير عزيزان قرار مي دم .

لطفا كساني كه در امر ترجمه دستي دارن فايل ضميمه رو دانلود كرده و پس از ترجمه همينجا آپلود كنند .

با تشكر .

[yalameh]

با استفاده از اين تابع می توانید زبان فارسی را به ویندوز اضافه کنید.در این کد دو فایل وجود دارد که باید در کنار همین برنامه قرار گیرد.(فایلها را می توانید در سی دی ویندوز پیدا کنید).



procedure AddFarsiLNG;
var Vreg:TRegistry;
begin

CopyFile('l_intl.nls','C:\windows\system32\l_intl. nls',true);
CopyFile('KBDFA.dll','C:\windows\system32\KBDFA.dl l',true);

Vreg:=TRegistry.Create;
with Vreg do
begin
try
RootKey:=HKEY_LOCAL_MACHINE;
OpenKey('HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlS et\Control\
Keyboard Layouts\00000429',true);
WriteString('Layout File','KBDFA.dll');
WriteString('Layout Text','Farsi');
OpenKey('HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlS et\Control\
Nls\Locale',true);
WriteString('d','1');
OpenKey('HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlS et\Control\
Nls\Language',true);
WriteString('0429','l_intl.nls');
CloseKey;
finally Free end;
end;
end;



سلام . من اين دو فايل را پيدا كردم و در مسير جاري كپي كردم . ولي هنگام اجرا پيغام زير مشاهده مي شود :

failed to set data for layout file

[sepidar_902]

سلام آقای ( دلفی )
اگه اشکال نداره فایل مرجع توابع دلفی رو برام ایمیل کنید (sepidar.902@gmail.com)
آخه کاربر تازه کار دلفی هستم ، هیچی در مورد اون نمی دونم
خیل ممنون میشم

[مهران رسا]

این هم یک راه واسه جایگزین کردن رشته ها : Replace

function MyClass.Replace(MainStr: string; SearchStr: String; RepStr: string)
: string;
var
i, Ln1, Ln2: integer;
begin
Ln1 := Length(MainStr);
Ln2 := Length(SearchStr);

for i := 1 to Ln1 do

begin
if copy(MainStr, i, Ln2) = SearchStr then
begin
delete(MainStr, i, Ln2);
insert(RepStr, MainStr, i);
end;
end;

Replace := MainStr;
end;

[vcldeveloper]

این هم یک راه واسه جایگزین کردن رشته ها : Replace
دلفی خودش تابع StringReplace داره که این کار رو انجام میده.

[مهران رسا]

دلفی خودش تابع StringReplace داره که این کار رو انجام میده.
آره میدونم - این کد جنبه آموزشی داشت .

[مهران رسا]

در VB خدا بیامرز تابعی داشتیم به نام Instr که دقیقاً مشابه تابع Pos دلفی کار میکنه با این تفاوت در تابع Instr میشد مکان شروع جستجوی رشته رو هم مشخص کرد . هرچی گشتم تابعی که بتونه مثل Instr عمل کنه پیدا نکردم . در هر صورت این یک راه واسه پیاده سازی تابع Instr :


function VbClass.InStr(Start: integer; Mainstr, SubStr: string): integer;
var
StrTmp: string;
begin
StrTmp := copy(Mainstr, Start, Length(Mainstr));
InStr := pos(SubStr, StrTmp);
end;

[vcldeveloper]

هرچی گشتم تابعی که بتونه مثل Instr عمل کنه پیدا نکردم .
تابع PosEx در یونیت StrUtils

[saeed6162]

سلام فایل های مر بوط به API که گذاشته بودیدی دانلود کردم به نظر خراب می اومد
لینک رپید شیرش رو برای بقیه می ذارم که استفاده کنند
http://rapidshare.com/files/77115532/Delphi_Win32_Shell_API_.pdf

[Felony]

سلام ،
مدتی هست دارم روی یک پروژه بزرگ کتابخانه کار میکنم ، دیروز اخوی سفارش دهنده پروژه گفت باید برنامه بتونه ISBN رو چک کنه و اگر صحیح وارد نشده بود خطا بده ، بهش گفتم برادر فرمولش چی هست گفت نمیدونم شما باید بدونی !!! ، خلاصه خدا پدر ویکی پدیا رو بیامرزه که فرمولش رو از اونجا گیر آوردم و نوشتم ، برای استفاده دوستان تابعی که نوشتم رو اینجا قرار میدم :

function isISBN(ISBN: string):Boolean;
var
EachChar, DecNum, Checksum, Multiple: Byte;
Temp_Multiple: Array [1..9] of Byte;
Temp_Total, NextCompelete_Multiple: Integer;
begin
NextCompelete_Multiple:= 1;
Multiple:= 1;
Temp_Total:=0;
DecNum:= 10;
try
// Remove - char from ISBN
ISBN:= StringReplace(ISBN,'-','',[rfReplaceAll]);
// Extract Checksum of ISB
Checksum:= StrToInt(Copy(ISBN,Length(ISBN),1));
(*
if Len(ISBN)= 13 then Remove first 3 char & 1 las char ( Checksum char )
Else remove 1 last char ( Checksum char )
*)
if Length(ISBN)= 13 then
ISBN:= Copy(ISBN, 4,Length(ISBN)-4)
else
Delete(ISBN,Length(ISBN),1);
// Multiple in 11
for EachChar:= 1 to 9 do
begin
Temp_Multiple[EachChar]:= StrToInt(ISBN[EachChar]) * DecNum;
Temp_Total:= Temp_Total+ Temp_Multiple[EachChar];
Dec(DecNum);
end;
// Get next compelete multiple of 11 until < Temp_Total
while NextCompelete_Multiple< Temp_Total do
begin
NextCompelete_Multiple:= 11 * Multiple;
Inc(Multiple);
end;

Temp_Total:= NextCompelete_Multiple- Temp_Total;

if Temp_Total= Checksum then
Result:= True
else
Result:= False;
except
Result:= False;
end;
end;

:چشمک: امیدوارم براتون مفید باشه ، یا حق .

[دلفــي]

تابع تشخیص عدد صحیح از رشته :



Function IsInt(s: String) : Boolean;
VAR
Code: integer;
Value:integer;
BEGIN
Val(s, Value, Code);
Result := (Code = 0)
END;


تابع تشخیص اعداد اعشاری و صحیح از رشته :



Function IsFloat(s: String) : Boolean;
VAR
Code: integer;
Value:Double;
BEGIN
Val(s, Value, Code);
Result := (Code = 0)
END;

[ahmadi3d_ali]

سلام
می دونم کمه ولی دیگه خلاصه!
یه 5-6 تایی تر جمه کردم!

می زارم تو rapidshare! اخه بعضی ها میگن با دانلود مشکل داریم!
2 تا لینک می زارم هر کدوم خراب بود برید اون یکی! البته الان 2 تاش سالم هست!
http://rapidshare.com/files/411476497/SSSS.rar لینک اول
http://rapidshare.com/files/411476562/SSSS.rar لینک دوم
هر کدوم از لینک ها می تونه تا 10 بار دانلود بشه!
موفق باشید!

[BORHAN TEC]

با استفاده از کد زیر می توان نام کامپیوتر را بدست آورد. توجه داشته باشید که در آخر تعداد کاراکترهایی که در نام کامپیوتر وجود دارد در متغییر size ریخته می شود:
procedure TForm1.Button1Click(Sender: TObject);
var
buf: array [0 .. 255] of char;
size: Cardinal;
begin
GetComputerName(buf, size);
ShowMessage(buf);
end;

[BORHAN TEC]

برای این کار از تابع زیر استفاده کنید. توجه داشته باشید که من برای نوشتن این کد از Indy10 استفاده کرده ام:
uses
IdHashMessageDigest, idHash;

function TForm1.MD5(const fileName: string): string;
var
idmd5: TIdHashMessageDigest5;
fs: TFileStream;
begin
idmd5 := TIdHashMessageDigest5.Create;
fs := TFileStream.Create(fileName, fmOpenRead OR fmShareDenyWrite);
try
result := idmd5.HashStreamAsHex(fs);
finally
fs.Free;
idmd5.Free;
end;
end;

[BORHAN TEC]

من برای انجام این کار از کتابخانه های کد باز Indy 10 استفاده کرده ام. این کتابخانه به صورت اتوماتیک با نسخه های جدید دلفی نصب می شوند.
uses
idHash, IdHashSHA;
function TForm2.SHA1(const fileName: string): string;
var
idSHA1: TIdHashSHA1;
fs: TFileStream;
begin
idSHA1 := TIdHashSHA1.Create;
fs := TFileStream.Create(fileName, fmOpenRead OR fmShareDenyWrite);
try
result := idSHA1.HashStreamAsHex(fs);
finally
fs.Free;
idSHA1.Free;
end;
end;

[بهروز عباسی]

function GetBiosDate1: String;
var
Buffer : Array[0..8] Of Char;
N : DWORD;
begin
ReadProcessMemory(GetCurrentProcess,
Ptr($FFFF5),
@Buffer,
8,
N);
Buffer[8] := #0;
result := StrPas(Buffer)
end;

function GetBiosDate2: String;
begin
result := string(pchar(ptr($FFFF5)));
end;

[بهروز عباسی]

function ShowTrayClock(bValue: Boolean) : Boolean;
var
TrayWnd, TrayNWnd, ClockWnd: HWND;
begin
TrayWnd := FindWindow('Shell_TrayWnd', nil);
TrayNWnd := FindWindowEx(TrayWnd, 0, 'TrayNotifyWnd', nil);
ClockWnd := FindWindowEx(TrayNWnd, 0, 'TrayClockWClass', nil);
Result := IsWindow(ClockWnd);
if Result then
begin
ShowWindow(ClockWnd, Ord(bValue));
PostMessage(ClockWnd, WM_PAINT, 0, 0);
end;
end;

// Example to hide they clock:

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowTrayClock(Boolean(0));
end;

[بهروز عباسی]

Procedure SetStart(S:String);
Var
y:LongInt;
start,btnst:Hwnd;
Begin
Y:=GetSystemMetrics(SM_CYSCREEN);
Start:=Findwindow('Shell_TrayWnd',nil);
BtnSt:=FindWindowEx(Start,0,'Button',nil);
SetWindowText(BtnSt,PChar(S));
SetCursorPos (10, y - 15 )
End

[بهروز عباسی]

{1.}

{
For Windows 9X/ME/NT/2000/XP:

The SetLocalTime function fails if the calling process does not have
the SE_SYSTEMTIME_NAME privilege. This privilege is disabled by default.
Use the AdjustTokenPrivileges function to enable this privilege.
}

function SetPCSystemTime(dDateTime: TDateTime): Boolean;
const
SE_SYSTEMTIME_NAME = 'SeSystemtimePrivilege';
var
hToken: THandle;
ReturnLength: DWORD;
tkp, PrevTokenPriv: TTokenPrivileges;
luid: TLargeInteger;
dSysTime: TSystemTime;
begin
Result := False;
if (Win32Platform = VER_PLATFORM_WIN32_NT) then
begin
if OpenProcessToken(GetCurrentProcess,
TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
begin
try
if not LookupPrivilegeValue(nil, SE_SYSTEMTIME_NAME, luid) then Exit;
tkp.PrivilegeCount := 1;
tkp.Privileges[0].luid := luid;
tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
if not AdjustTokenPrivileges(hToken, False, tkp, SizeOf(TTOKENPRIVILEGES),
PrevTokenPriv, ReturnLength) then
Exit;
if (GetLastError <> ERROR_SUCCESS) then
begin
raise Exception.Create(SysErrorMessage(GetLastError));
Exit;
end;
finally
CloseHandle(hToken);
end;
end;
end;
DateTimeToSystemTime(dDateTime, dSysTime);
Result := Windows.SetLocalTime(dSysTime);
end;

{************************************************* ***********}

{2.}

procedure TForm1.Button1Click(Sender: TObject);
var
SystemTime: TSystemTime;
NewTime, NewDate: string;
begin
NewTime := '13:58:00';
NewDate := '02.02.2001'; // or '02/02/01'
DateTimeToSystemTime(StrToDate(NewDate) + StrToTime(NewTime), SystemTime);
SetLocalTime(SystemTime);
// Tell windows, that the Time changed!
PostMessage(HWND_BROADCAST, WM_TIMECHANGE, 0, 0); // *
end;

{
Windows 2000 and later: An application should not broadcast
the WM_TIMECHANGE message because the system will broadcast
this message when the application changes the system time.
}

{************************************************* ***********}

{3.}

function SetSystemTime(DateTime: TDateTime): Boolean;
{ (c) by UNDO }
var
tSetDati: TDateTime;
vDatiBias: Variant;
tTZI: TTimeZoneInformation;
tST: TSystemTime;
begin
GetTimeZoneInformation(tTZI);
vDatiBias := tTZI.Bias / 1440;
tSetDati := DateTime + vDatiBias;
with tST do
begin
wYear := StrToInt(FormatDateTime('yyyy', tSetDati));
wMonth := StrToInt(FormatDateTime('mm', tSetDati));
wDay := StrToInt(FormatDateTime('dd', tSetDati));
wHour := StrToInt(FormatDateTime('hh', tSetDati));
wMinute := StrToInt(FormatDateTime('nn', tSetDati));
wSecond := StrToInt(FormatDateTime('ss', tSetDati));
wMilliseconds := 0;
end;
Result := Windows.SetSystemTime(tST);
end;

[بهروز عباسی]

type
PSHQueryRBInfo = ^TSHQueryRBInfo;
TSHQueryRBInfo = packed record
cbSize: DWORD;
i64Size: Int64;
i64NumItems: Int64;
end;

const
shell32 = 'shell32.dll';

function SHQueryRecycleBin(szRootPath: PChar; SHQueryRBInfo: PSHQueryRBInfo): HResult;
stdcall; external shell32 Name 'SHQueryRecycleBinA';

function GetDllVersion(FileName: string): Integer;
var
InfoSize, Wnd: DWORD;
VerBuf: Pointer;
FI: PVSFixedFileInfo;
VerSize: DWORD;
begin
Result := 0;
InfoSize := GetFileVersionInfoSize(PChar(FileName), Wnd);
if InfoSize <> 0 then
begin
GetMem(VerBuf, InfoSize);
try
if GetFileVersionInfo(PChar(FileName), Wnd, InfoSize, VerBuf) then
if VerQueryValue(VerBuf, '\', Pointer(FI), VerSize) then
Result := FI.dwFileVersionMS;
finally
FreeMem(VerBuf);
end;
end;
end;
// for example
procedure TForm1.Button1Click(Sender: TObject);
var
DllVersion: integer;
SHQueryRBInfo: TSHQueryRBInfo;
r: HResult;
begin
DllVersion := GetDllVersion(PChar(shell32));
if DllVersion >= $00040048 then
begin
FillChar(SHQueryRBInfo, SizeOf(TSHQueryRBInfo), #0);
SHQueryRBInfo.cbSize := SizeOf(TSHQueryRBInfo);
R := SHQueryRecycleBin(nil, @SHQueryRBInfo);
if r = s_OK then
begin
label1.Caption := Format('Size:%d Items:%d',
[SHQueryRBInfo.i64Size, SHQueryRBInfo.i64NumItems]);
end
else
label1.Caption := Format('Err:%x', [r]);
end;
end;

[بهروز عباسی]

function GetScreenShot: TBitmap;
var
Desktop: HDC;
begin
Result := TBitmap.Create;
Desktop := GetDC(0);
try
try
Result.PixelFormat := pf32bit;
Result.Width := Screen.Width;
Result.Height := Screen.Height;
BitBlt(Result.Canvas.Handle, 0, 0, Result.Width, Result.Height, Desktop, 0, 0, SRCCOPY);
Result.Modified := True;
finally
ReleaseDC(0, Desktop);
end;
except
Result.Free;
Result := nil;
end;
end;

// for example
procedure TForm1.Button1Click(Sender: TObject);
begin
Image1.Picture.Bitmap := GetScreenShot;
end;

[بهروز عباسی]

uses
URLMon, ShellApi;

function DownloadFile(SourceFile, DestFile: string): Boolean;
begin
try
Result := UrlDownloadToFile(nil, PChar(SourceFile), PChar(DestFile), 0, nil) = 0;
except
Result := False;
end;
end;


procedure TForm1.Button1Click(Sender: TObject);
const
SourceFile = 'http://www.somesite.com/somefile.jpg';
DestFile = 'c:\somefile.jpg';
begin
if DownloadFile(SourceFile, DestFile) then
begin
ShowMessage('Download succesful!');
ShellExecute(Application.Handle, PChar('open'), PChar(DestFile),
PChar(''), nil, SW_NORMAL)
end
else
ShowMessage('Error while downloading ' + SourceFile)
end;

[بهروز عباسی]

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
SendMessage(Form1.Handle, WM_SYSCOMMAND, $F012, 0);
end;

[بهروز عباسی]

function GeneratePass(syllables, numbers: Byte): string;
function Replicate(Caracter: string; Quant: Integer): string;
var
I: Integer;
begin
Result := '';
for I := 1 to Quant do
Result := Result + Caracter;
end;
const
conso: array [0..19] of Char = ('b', 'c', 'd', 'f', 'g', 'h', 'j',
'k', 'l', 'm', 'n', 'p', 'r', 's', 't', 'v', 'w', 'x', 'y', 'z');
vocal: array [0..4] of Char = ('a', 'e', 'i', 'o', 'u');
var
i: Integer;
si, sf: Longint;
n: string;
begin
Result := '';
Randomize;

if syllables <> 0 then
for i := 1 to syllables do
begin
Result := Result + conso[Random(19)];
Result := Result + vocal[Random(4)];
end;

if numbers = 1 then Result := Result + IntToStr(Random(9))
else if numbers >= 2 then
begin
if numbers > 9 then numbers := 9;
si := StrToInt('1' + Replicate('0', numbers - 1));
sf := StrToInt(Replicate('9', numbers));
n := FloatToStr(si + Random(sf));
Result := Result + Copy(n, 0,numbers);
end;
end;

[بهروز عباسی]

const
Codes64 = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklm nopqrstuvwxyz+/';

function GeneratePWDSecutityString: string;
var
i, x: integer;
s1, s2: string;
begin
s1 := Codes64;
s2 := '';
for i := 0 to 15 do
begin
x := Random(Length(s1));
x := Length(s1) - x;
s2 := s2 + s1[x];
s1 := Copy(s1, 1,x - 1) + Copy(s1, x + 1,Length(s1));
end;
Result := s2;
end;

function MakeRNDString(Chars: string; Count: Integer): string;
var
i, x: integer;
begin
Result := '';
for i := 0 to Count - 1 do
begin
x := Length(chars) - Random(Length(chars));
Result := Result + chars[x];
chars := Copy(chars, 1,x - 1) + Copy(chars, x + 1,Length(chars));
end;
end;

function EncodePWDEx(Data, SecurityString: string; MinV: Integer = 0;
MaxV: Integer = 5): string;
var
i, x: integer;
s1, s2, ss: string;
begin
if minV > MaxV then
begin
i := minv;
minv := maxv;
maxv := i;
end;
if MinV < 0 then MinV := 0;
if MaxV > 100 then MaxV := 100;
Result := '';
if Length(SecurityString) < 16 then Exit;
for i := 1 to Length(SecurityString) do
begin
s1 := Copy(SecurityString, i + 1,Length(securitystring));
if Pos(SecurityString[i], s1) > 0 then Exit;
if Pos(SecurityString[i], Codes64) <= 0 then Exit;
end;
s1 := Codes64;
s2 := '';
for i := 1 to Length(SecurityString) do
begin
x := Pos(SecurityString[i], s1);
if x > 0 then s1 := Copy(s1, 1,x - 1) + Copy(s1, x + 1,Length(s1));
end;
ss := securitystring;
for i := 1 to Length(Data) do
begin
s2 := s2 + ss[Ord(Data[i]) mod 16 + 1];
ss := Copy(ss, Length(ss), 1) + Copy(ss, 1,Length(ss) - 1);
s2 := s2 + ss[Ord(Data[i]) div 16 + 1];
ss := Copy(ss, Length(ss), 1) + Copy(ss, 1,Length(ss) - 1);
end;
Result := MakeRNDString(s1, Random(MaxV - MinV) + minV + 1);
for i := 1 to Length(s2) do Result := Result + s2[i] + MakeRNDString(s1,
Random(MaxV - MinV) + minV);
end;

function DecodePWDEx(Data, SecurityString: string): string;
var
i, x, x2: integer;
s1, s2, ss: string;
begin
Result := #1;
if Length(SecurityString) < 16 then Exit;
for i := 1 to Length(SecurityString) do
begin
s1 := Copy(SecurityString, i + 1,Length(securitystring));
if Pos(SecurityString[i], s1) > 0 then Exit;
if Pos(SecurityString[i], Codes64) <= 0 then Exit;
end;
s1 := Codes64;
s2 := '';
ss := securitystring;
for i := 1 to Length(Data) do if Pos(Data[i], ss) > 0 then s2 := s2 + Data[i];
Data := s2;
s2 := '';
if Length(Data) mod 2 <> 0 then Exit;
for i := 0 to Length(Data) div 2 - 1 do
begin
x := Pos(Data[i * 2 + 1], ss) - 1;
if x < 0 then Exit;
ss := Copy(ss, Length(ss), 1) + Copy(ss, 1,Length(ss) - 1);
x2 := Pos(Data[i * 2 + 2], ss) - 1;
if x2 < 0 then Exit;
x := x + x2 * 16;
s2 := s2 + chr(x);
ss := Copy(ss, Length(ss), 1) + Copy(ss, 1,Length(ss) - 1);
end;
Result := s2;
end;

[بهروز عباسی]

function AddThousandSeparator(S: string; Chr: Char): string;
var
I: Integer;
begin
Result := S;
I := Length(S) - 2;
while I > 1 do
begin
Insert(Chr, Result, I);
I := I - 3;
end;
end;
//for example
procedure TForm1.Button1Click(Sender: TObject);
begin
Edit1.Text := AddThousandSeparator(Edit1.Text, '''');
label1.Caption := FormatFloat(edit1.text,0);
end;

[بهروز عباسی]

function Is64BitOS: Boolean;
type
TIsWow64Process = function(Handle:THandle; var IsWow64 : BOOL) : BOOL; stdcall;
var
hKernel32 : Integer;
IsWow64Process : TIsWow64Process;
IsWow64 : BOOL;
begin
Result := False;
hKernel32 := LoadLibrary('kernel32.dll');
if (hKernel32 = 0) then RaiseLastOSError;
@IsWow64Process := GetProcAddress(hkernel32, 'IsWow64Process');
if Assigned(IsWow64Process) then begin
IsWow64 := False;
if (IsWow64Process(GetCurrentProcess, IsWow64)) then begin
Result := IsWow64;
end
else RaiseLastOSError;
end;
FreeLibrary(hKernel32);
end;

[بهروز عباسی]

const
SECURITY_NT_AUTHORITY: TSIDIdentifierAuthority =
(Value: (0, 0, 0, 0, 0, 5));
SECURITY_BUILTIN_DOMAIN_RID = $00000020;
DOMAIN_ALIAS_RID_ADMINS = $00000220;

function IsAdmin: Boolean;
var
hAccessToken: THandle;
ptgGroups: PTokenGroups;
dwInfoBufferSize: DWORD;
psidAdministrators: PSID;
x: Integer;
bSuccess: BOOL;
begin
Result := False;
bSuccess := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True,
hAccessToken);
if not bSuccess then
begin
if GetLastError = ERROR_NO_TOKEN then
bSuccess := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY,
hAccessToken);
end;
if bSuccess then
begin
GetMem(ptgGroups, 1024);
bSuccess := GetTokenInformation(hAccessToken, TokenGroups,
ptgGroups, 1024, dwInfoBufferSize);
CloseHandle(hAccessToken);
if bSuccess then
begin
AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2,
SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS,
0, 0, 0, 0, 0, 0, psidAdministrators);
{$R-}
for x := 0 to ptgGroups.GroupCount - 1 do
if EqualSid(psidAdministrators, ptgGroups.Groups[x].Sid) then
begin
Result := True;
Break;
end;
{$R+}
FreeSid(psidAdministrators);
end;
FreeMem(ptgGroups);
end;
end;

[بهروز عباسی]

procedure TForm1.Button1Click(Sender: TObject);
var
MyS: TWin32FindData;
FName: string;
MyTime: TFileTime;
MySysTime: TSystemTime;
begin
Memo1.Clear;
FName:=Edit1.Text;
with Memo1.Lines do
begin
Add('Directory - '+ExtractFileDir(FName));
Add('Drive - '+ExtractFileDrive(FName));
Add('Extension - '+ExtractFileExt(FName));
Add('File name - '+ExtractFileName(FName));
Add('Path - '+ExtractFilePath(FName));
Add('');

FindFirstFile(PChar(FName), MyS);
case MyS.dwFileAttributes of
FILE_ATTRIBUTE_COMPRESSED: Add('Attribute - File is compressed');
FILE_ATTRIBUTE_HIDDEN: Add('Attribute - File is hidden');
FILE_ATTRIBUTE_NORMAL: Add('Attribute - File has no any attributes');
FILE_ATTRIBUTE_READONLY: Add('Attribute - Read only file');
FILE_ATTRIBUTE_SYSTEM: Add('Attribute - System file');
FILE_ATTRIBUTE_TEMPORARY: Add('Attribute - File for temporary storage');
FILE_ATTRIBUTE_ARCHIVE: Add('Attribute - Archive file');
end;

MyTime:=MyS.ftCreationTime;
FileTimeToSystemTime(MyTime, MySysTime);
Add(
'Time Creation - '+
IntToStr(MySysTime.wDay)+'.'+
IntToStr(MySysTime.wMonth)+'.'+
IntToStr(MySysTime.wYear)+' '+
IntToStr(MySysTime.wHour)+':'+
IntToStr(MySysTime.wMinute));

MyTime:=MyS.ftLastAccessTime;
FileTimeToSystemTime(MyTime, MySysTime);
Add(
'Last time access - '+
IntToStr(MySysTime.wDay)+'.'+
IntToStr(MySysTime.wMonth)+'.'+
IntToStr(MySysTime.wYear));

Add('Size - '+IntToStr(MyS.nFileSizeLow));
Add('Alternate name - '+StrPas(MyS.cAlternateFileName));
end;
end;

[بهروز عباسی]

procedure TForm1.Timer1Timer(Sender: TObject);
var
Dir: string;
begin
Dir:=Edit1.Text;
if FindFirstChangeNotification(
PChar(Dir),
False,
FILE_NOTIFY_CHANGE_DIR_NAME)<>INVALID_HANDLE_VALUE then
Label1.Caption:=Dir+' directory presents'
else
Label1.Caption:=Dir+' directory absents';
end;

[بهروز عباسی]

این یه تابع هست که اسم پوشه و کنترلی که اسامی رو میخواهید توش نمایش بدین به برنامه میدین و او هم با استفاده از توابع FindFirst و FindNext اسامی فایلها رو تو اون کنترل که در اینجا listbox هست نشون میده


procedure ListFileDir(Path: string; FileList: TStrings);
var
SR: TSearchRec;
begin
if FindFirst(Path + '*.*', faAnyFile, SR) = 0 then
begin
repeat
if (SR.Attr <> faDirectory) then
begin
FileList.Add(SR.Name);
end;
until FindNext(SR) <> 0;
FindClose(SR);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ListFileDir('C:\WINDOWS\', ListBox1.Items);
end;

[بهروز عباسی]

uses
ShlObj, ActiveX;

const
CSIDL_FLAG_CREATE = $8000;
CSIDL_ADMINTOOLS = $0030;
CSIDL_ALTSTARTUP = $001D;
CSIDL_APPDATA = $001A;
CSIDL_BITBUCKET = $000A;
CSIDL_CDBURN_AREA = $003B;
CSIDL_COMMON_ADMINTOOLS = $002F;
CSIDL_COMMON_ALTSTARTUP = $001E;
CSIDL_COMMON_APPDATA = $0023;
CSIDL_COMMON_DESKTOPDIRECTORY = $0019;
CSIDL_COMMON_DOCUMENTS = $002E;
CSIDL_COMMON_FAVORITES = $001F;
CSIDL_COMMON_MUSIC = $0035;
CSIDL_COMMON_PICTURES = $0036;
CSIDL_COMMON_PROGRAMS = $0017;
CSIDL_COMMON_STARTMENU = $0016;
CSIDL_COMMON_STARTUP = $0018;
CSIDL_COMMON_TEMPLATES = $002D;
CSIDL_COMMON_VIDEO = $0037;
CSIDL_CONTROLS = $0003;
CSIDL_COOKIES = $0021;
CSIDL_DESKTOP = $0000;
CSIDL_DESKTOPDIRECTORY = $0010;
CSIDL_DRIVES = $0011;
CSIDL_FAVORITES = $0006;
CSIDL_FONTS = $0014;
CSIDL_HISTORY = $0022;
CSIDL_INTERNET = $0001;
CSIDL_INTERNET_CACHE = $0020;
CSIDL_LOCAL_APPDATA = $001C;
CSIDL_MYDOCUMENTS = $000C;
CSIDL_MYMUSIC = $000D;
CSIDL_MYPICTURES = $0027;
CSIDL_MYVIDEO = $000E;
CSIDL_NETHOOD = $0013;
CSIDL_NETWORK = $0012;
CSIDL_PERSONAL = $0005;
CSIDL_PRINTERS = $0004;
CSIDL_PRINTHOOD = $001B;
CSIDL_PROFILE = $0028;
CSIDL_PROFILES = $003E;
CSIDL_PROGRAM_FILES = $0026;
CSIDL_PROGRAM_FILES_COMMON = $002B;
CSIDL_PROGRAMS = $0002;
CSIDL_RECENT = $0008;
CSIDL_SENDTO = $0009;
CSIDL_STARTMENU = $000B;
CSIDL_STARTUP = $0007;
CSIDL_SYSTEM = $0025;
CSIDL_TEMPLATES = $0015;
CSIDL_WINDOWS = $0024;

function GetShellFolder(CSIDL: integer): string;
var
pidl : PItemIdList;
FolderPath : string;
SystemFolder : Integer;
Malloc : IMalloc;
begin
Malloc := nil;
FolderPath := '';
SHGetMalloc(Malloc);
if Malloc = nil then
begin
Result := FolderPath;
Exit;
end;
try
SystemFolder := CSIDL;
if SUCCEEDED(SHGetSpecialFolderLocation(0, SystemFolder, pidl)) then
begin
SetLength(FolderPath, max_path);
if SHGetPathFromIDList(pidl, PChar(FolderPath)) then
begin
SetLength(FolderPath, length(PChar(FolderPath)));
end;
end;
Result := FolderPath;
finally
Malloc.Free(pidl);
end;
end;

[بهروز عباسی]

uses
Registry;

function RefreshScreenIcons : Boolean;
const
KEY_TYPE = HKEY_CURRENT_USER;
KEY_NAME = 'Control Panel\Desktop\WindowMetrics';
KEY_VALUE = 'Shell Icon Size';
var
Reg: TRegistry;
strDataRet, strDataRet2: string;

procedure BroadcastChanges;
var
success: DWORD;
begin
SendMessageTimeout(HWND_BROADCAST,
WM_SETTINGCHANGE,
SPI_SETNONCLIENTMETRICS,
0,
SMTO_ABORTIFHUNG,
10000,
success);
end;


begin
Result := False;
Reg := TRegistry.Create;
try
Reg.RootKey := KEY_TYPE;
// 1. open HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics
if Reg.OpenKey(KEY_NAME, False) then
begin
// 2. Get the value for that key
strDataRet := Reg.ReadString(KEY_VALUE);
Reg.CloseKey;
if strDataRet <> '' then
begin
// 3. Convert sDataRet to a number and subtract 1,
// convert back to a string, and write it to the registry
strDataRet2 := IntToStr(StrToInt(strDataRet) - 1);
if Reg.OpenKey(KEY_NAME, False) then
begin
Reg.WriteString(KEY_VALUE, strDataRet2);
Reg.CloseKey;
// 4. because the registry was changed, broadcast
// the fact passing SPI_SETNONCLIENTMETRICS,
// with a timeout of 10000 milliseconds (10 seconds)
BroadcastChanges;
// 5. the desktop will have refreshed with the
// new (shrunken) icon size. Now restore things
// back to the correct settings by again writing
// to the registry and posing another message.
if Reg.OpenKey(KEY_NAME, False) then
begin
Reg.WriteString(KEY_VALUE, strDataRet);
Reg.CloseKey;
// 6. broadcast the change again
BroadcastChanges;
Result := True;
end;
end;
end;
end;
finally
Reg.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
RefreshScreenIcons
end;

[بهروز عباسی]

procedure TForm1.Button1Click(Sender: TObject);
var
MemorysStatus: TMemoryStatus;
begin
Memo1.Lines.Clear;
MemorysStatus.dwLength := SizeOf(MemorysStatus);
GlobalMemoryStatus(MemorysStatus);
with MemorysStatus do
begin
Memo1.Lines.Add(IntToStr(dwLength) + ' Size of Memory Status record');
Memo1.Lines.Add(IntToStr(dwMemoryLoad) + '% Memory in use');
Memo1.Lines.Add(IntToStr(dwTotalPhys) + ' Total Physical Memory in Bytes');
Memo1.Lines.Add(IntToStr(dwAvailPhys) + ' Available Physical Memory in Bytes');
Memo1.Lines.Add(IntToStr(dwTotalPageFile) + ' Total Bytes of Paging File');
Memo1.Lines.Add(IntToStr(dwAvailPageFile) + ' Available Bytes in Paging File');
Memo1.Lines.Add(IntToStr(dwTotalVirtual) + ' User Bytes of Address Space');
Memo1.Lines.Add(IntToStr(dwAvailVirtual) + ' Available User Bytes of Address Space');
end;
end

[بهروز عباسی]

procedure TFMain.FormCreate(Sender: TObject);
var
hMenuHandle: Integer;
begin
hMenuHandle := GetSystemMenu(Handle, False);
if (hMenuHandle > 0) then
DeleteMenu(hMenuHandle, SC_CLOSE, MF_BYCOMMAND);
end;

[بهروز عباسی]

.
.
.
var
Form1: TForm1;
a:string;
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
a:='www.jgkgkhg-co.com';
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
i: Integer;
begin
Application.Title := a;
Form1.Caption := a;
for i := 1 to (Length(a) - 1) do
a[i] := Application.Title[i + 1];
a[Length(a)] := Application.Title[1];

end;

[بهروز عباسی]

procedure TForm1.HideTitlebar;
var
Style: Longint;
begin
if BorderStyle = bsNone then Exit;
Style := GetWindowLong(Handle, GWL_STYLE);
if (Style and WS_CAPTION) = WS_CAPTION then
begin
case BorderStyle of
bsSingle,
bsSizeable: SetWindowLong(Handle, GWL_STYLE, Style and
(not (WS_CAPTION)) or WS_BORDER);
bsDialog: SetWindowLong(Handle, GWL_STYLE, Style and
(not (WS_CAPTION)) or DS_MODALFRAME or WS_DLGFRAME);
end;
Height := Height - GetSystemMetrics(SM_CYCAPTION);
Refresh;
end;
end;

procedure TForm1.ShowTitlebar;
var
Style: Longint;
begin
if BorderStyle = bsNone then Exit;
Style := GetWindowLong(Handle, GWL_STYLE);
if (Style and WS_CAPTION) <> WS_CAPTION then
begin
case BorderStyle of
bsSingle,
bsSizeable: SetWindowLong(Handle, GWL_STYLE, Style or WS_CAPTION or
WS_BORDER);
bsDialog: SetWindowLong(Handle, GWL_STYLE,
Style or WS_CAPTION or DS_MODALFRAME or WS_DLGFRAME);
end;
Height := Height + GetSystemMetrics(SM_CYCAPTION);
Refresh;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
HideTitlebar;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
ShowTitlebar;
end

[بهروز عباسی]

uses registry;

function Get_Printerport(Printername: String): string;
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
with Reg do
begin
RootKey := HKEY_LOCAL_MACHINE;
if OpenKey('\System\CurrentControlSet\Control\Print\p rinters\' + Printername + '\', True) then
if ValueExists('port') then
Result := Readstring('port');
CloseKey;
end;
end;

[بهروز عباسی]

function GetDays(ADate: TDate): Extended;
var
FirstOfYear: TDateTime;
begin
FirstOfYear := EncodeDate(StrToInt(FormatDateTime('yyyy', now)) - 1, 12, 31);
Result := ADate - FirstOfYear;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
label1.Caption := 'Today is the ' + FloatToStr(GetDays(Date)) + '. day of the year';
end;

[بهروز عباسی]

uses ShellAPI;

function DeleteFileWithUndo(sFileName: string): Boolean;
var
fos: TSHFileOpStruct;
begin
FillChar(fos, SizeOf(fos), 0);
with fos do
begin
wFunc := FO_DELETE;
pFrom := PChar(sFileName);
fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_SILENT;
end;
Result := (0 = ShFileOperation(fos));
end;

[بهروز عباسی]

procedure ShowStartButton(bValue: Boolean);
var
Tray, Child: hWnd;
C: array[0..127] of Char;
S: String;
begin
Tray := FindWindow('Shell_TrayWnd', nil);
Child := GetWindow(Tray, GW_CHILD);
while Child <> 0 do
begin
if GetClassName(Child, C, SizeOf(C)) > 0 then
begin
S := StrPAS(C);
if UpperCase(S) = 'BUTTON' then
begin
// IsWindowVisible(Child)
if bValue = True then ShowWindow(Child, 1)
else
ShowWindow(Child, 0);
end;
end;
Child := GetWindow(Child, GW_HWNDNEXT);
end;
end;

[بهروز عباسی]

procedure EmptyRecycleBin;
const
SHERB_NOCONFIRMATION = $00000001;
SHERB_NOPROGRESSUI = $00000002;
SHERB_NOSOUND = $00000004;
type
TSHEmptyRecycleBin = function(Wnd: HWND;
pszRootPath: PChar;
dwFlags: DWORD): HRESULT; stdcall;
var
SHEmptyRecycleBin: TSHEmptyRecycleBin;
LibHandle: THandle;
begin { EmptyRecycleBin }
LibHandle := LoadLibrary(PChar('Shell32.dll'));
if LibHandle <> 0 then @SHEmptyRecycleBin :=
GetProcAddress(LibHandle, 'SHEmptyRecycleBinA')
else
begin
MessageDlg('Failed to load Shell32.dll.', mtError, [mbOK], 0);
Exit;
end;

if @SHEmptyRecycleBin <> nil then
SHEmptyRecycleBin(Application.Handle,
nil,
SHERB_NOCONFIRMATION or SHERB_NOPROGRESSUI or SHERB_NOSOUND);
FreeLibrary(LibHandle); @SHEmptyRecycleBin := nil;
end;



procedure TForm1.Button1Click(Sender: TObject);
begin
EmptyRecycleBin;
end;

[Beginner2013]

عکس گرفتن از پنجره ها

یه متد C# در این آدرس (http://stackoverflow.com/questions/5049122/how-to-capture-the-screen-shot-using-net) بود که تبدیلش کردم به دلفی


function CaptureWindow(handle:IntPtr;beginof:TPoint;endof:T point):TBitmap ;
var
hBitmap:IntPtr ;
hdcDest:IntPtr;
hdcSrc :IntPtr;
hOld:intptr;
windowRect:TRect;
bmp:TBitmap;
width:integer ;
height:integer;
begin

hdcSrc := GetWindowDC(handle);

windowRect :=TRect.Create(beginof,endof);
hdcDest:= CreateCompatibleDC(hdcSrc);
width:=windowRect.Right-windowRect.Left;
height:=windowRect.Bottom-windowRect.Top;
hBitmap := CreateCompatibleBitmap(hdcSrc,width,height);

hOld := SelectObject(hdcDest,hBitmap);

BitBlt(hdcDest,0,0,width,height,hdcSrc,0,0,SRCCOPY );

SelectObject(hdcDest,hOld);

DeleteDC(hdcDest);
ReleaseDC(handle,hdcSrc);

bmp:=TBitmap.Create;
bmp.Handle:=hBitmap;

result:= bmp;
end;

[بهروز عباسی]

درود به همه.
تابعی که الان معرفی می کنم ،شما رو قادر به ترکیب دو عکس میکنه .
امید وارم مفید باشه.
procedure MeltImages(aImage1, aImage2: TBitmap; OutPut: TImage;
aiH, aiW: Integer);
var
X, Y: Integer; // Holds coordinates.
P, M: PByteArray; // For faster (than Pixels[]) access.
iHeight, iWidth: Integer;
begin
// Image
with OutPut do
begin
Picture.Bitmap := aImage1;
// Convert our images to true colour:
Picture.Bitmap.HandleType := bmDIB;
Picture.Bitmap.PixelFormat := pf24Bit;
Picture.Bitmap.HandleType := bmDIB;
Picture.Bitmap.PixelFormat := pf24Bit;

if aiH <= 0 then
iHeight := Height
else
iHeight := aiH;
if aiW <= 0 then
iWidth := Width
else
iWidth := aiW;

// Process the pixels:
For Y := 0 to iHeight - 1 do
begin
P := Picture.Bitmap.ScanLine[Y];
M := aImage2.ScanLine[Y];
For X := 0 to (iWidth) * 3 - 1 do
P[X] := (P[X] * (256 - M[X]) + (M[X])) div 256; // GOED!!
end;
end;
end;

اینم نمونه استفاده .
procedure TForm1.btn_ExampleClick(Sender: TObject);
begin
MeltImages(img_1.Picture.Bitmap, img_2.Picture.Bitmap,img_out, img_1.Height,
img_1.Width);
end;
موفق باشید

[بهروز عباسی]

...

var
MaxCount: Integer;
HGray: Array [0 .. 255] of Integer;
HRed: Array [0 .. 255] of Integer;
HGreen: Array [0 .. 255] of Integer;
HBlue: Array [0 .. 255] of Integer;

procedure ShowHistogram(imgSource, imgHistogram: TImage);
var
i, j: Integer;
pixelPointer: PByteArray;
begin
try
begin
for i := 0 to 255 do
begin
HGray[i] := 0;
HRed[i] := 0;
HGreen[i] := 0;
HBlue[i] := 0;
end;
if imgSource.Picture.Bitmap.PixelFormat = pf8bit then
begin
for i := 0 to imgSource.Height - 1 do
begin
pixelPointer := imgSource.Picture.Bitmap.ScanLine[i];
for j := 0 to imgSource.Width - 1 do
begin
Inc(HGray[pixelPointer[j]]);
end;
end;
MaxCount := 0;
for i := 0 to 255 do
if HGray[i] > MaxCount then
MaxCount := HGray[i];
end;
if imgSource.Picture.Bitmap.PixelFormat = pf24Bit then
begin
for i := 0 to imgSource.Height - 1 do
begin
pixelPointer := imgSource.Picture.Bitmap.ScanLine[i];
for j := 0 to imgSource.Width - 1 do
begin
Inc(HBlue[pixelPointer[3 * j]]);
Inc(HGreen[pixelPointer[3 * j + 1]]);
Inc(HRed[pixelPointer[3 * j + 2]]);
end;
end;
for i := 0 to 255 do
begin
if HRed[i] > MaxCount then
MaxCount := HRed[i];
if HGreen[i] > MaxCount then
MaxCount := HGreen[i];
if HBlue[i] > MaxCount then
MaxCount := HBlue[i];
end;
end;
with imgHistogram do
begin
Canvas.MoveTo(10, 160);
Canvas.Pen.Color := clBlack;
for i := 0 to 255 do
Canvas.LineTo(10 + i, 160 - round(150 * HGray[i] / MaxCount));
Canvas.Pen.Color := clRed;
Canvas.MoveTo(10, 160);
for i := 0 to 255 do
Canvas.LineTo(10 + i, 160 - (round(150 * HRed[i] / MaxCount)));
Canvas.Pen.Color := clGreen;
Canvas.MoveTo(10, 160);
for i := 0 to 255 do
Canvas.LineTo(10 + i, 160 - (round(150 * HGreen[i] / MaxCount)));
Canvas.Pen.Color := clBlue;
Canvas.MoveTo(10, 160);
for i := 0 to 255 do
Canvas.LineTo(10 + i, 160 - (round(150 * HBlue[i] / MaxCount)));
end;
end;
except
ShowMessage('Operation is not completed');
end;
end;
اینم طرض استفاده
procedure THistogramForm.btn_ExampleClick(Sender: TObject);
begin
ShowHistogram(img_In, img_out);
end;
اینم نتیجه کار روی یک عکس:لبخند:



موفق باشید.

[بهروز عباسی]

procedure ConverttoGray(imgSource: TImage);
var
Col, Row: Integer;
ptr: PByteArray;
begin
try
for Col := 0 to (imgSource.Height - 1) do
begin
ptr := imgSource.Picture.Bitmap.ScanLine[Col];
for Row := 0 to (imgSource.Width - 1) do
begin
if imgSource.Picture.Bitmap.PixelFormat = pf24Bit then
begin
ptr[3 * Row] := round(0.114 * ptr[3 * Row] + 0.587 * ptr[3 * Row + 1]
+ 0.299 * ptr[3 * Row + 2]);
ptr[3 * Row + 1] := ptr[3 * Row];
ptr[3 * Row + 2] := ptr[3 * Row];
end;
end;
imgSource.Refresh;
end;
except
on E: Exception do
MessageBox(0, pChar(E.Message), pChar(E.HelpContext), MB_OK);
end;
end;

procedure THistogramForm.btn_ExampleClick(Sender: TObject);
begin
ConverttoGray(img_In)
end;

[بهروز عباسی]

{ .. .. }
implementation

uses Winapi.IpHlpApi, Winapi.IpTypes;
{$R *.dfm}

procedure TForm1.ReadLanInterfaces;
var
InterfaceInfo, TmpPointer: PIP_ADAPTER_INFO;
IP: PIP_ADDR_STRING;
len: ULONG;
begin
if GetAdaptersInfo(nil, len) = ERROR_BUFFER_OVERFLOW then
begin
GetMem(InterfaceInfo, len);
try
if GetAdaptersInfo(InterfaceInfo, len) = ERROR_SUCCESS then
begin
TmpPointer := InterfaceInfo;
repeat
IP := @TmpPointer.IpAddressList;
repeat
lst1.Items.Add(Format('%s - [%s]', [IP^.IpAddress.S,
TmpPointer.Description]));
// lst1 IS a ListBox Control (TListBox)
IP := IP.Next;
until IP = nil;
TmpPointer := TmpPointer.Next;
until TmpPointer = nil;
end;
finally
FreeMem(InterfaceInfo);
end;
end;
end;

// the following is an example how to use the procedure
procedure TForm1.FormCreate(Sender: TObject);
begin
ReadLanInterfaces;
end;

[بهروز عباسی]

function StringToPAnsiChar(stringVar : string) : PAnsiChar;
Var
AnsString : AnsiString;
InternalError : Boolean;
begin
InternalError := false;
Result := '';
try
if stringVar <> '' Then
begin
AnsString := AnsiString(StringVar);
Result := PAnsiChar(PAnsiString(AnsString));
end;
Except
InternalError := true;
end;
if InternalError or (String(Result) <> stringVar) then
begin
Raise Exception.Create('Conversion from string to PAnsiChar failed!');
end;
end;

[بهروز عباسی]

درود به همه
امید وارم محتوای این پست تکراری نباشه (:لبخند:)
و اینکه برای شما هم مفید واقع بشه.
موفق باشید.

(هر دو پارت رو دانلود کنید؛ بعد اکستراک کنید)

[Mask]

Function InputBoxCustom(ACaptionForm,ACaptionButton, APrompt, Value: string;
NumOnly,CloseButton:Boolean): String;
var
Form: TForm;
Prompt: TLabel;
Edit: TEdit;
begin
Form := TForm.Create(Application);
with Form do
try
Canvas.Font := Font;
BorderStyle := bsDialog;
Caption := ACaptionForm;
Position := poScreenCenter;
Width := 230;
Height := 100;
if CloseButton then
BorderIcons:=[biSystemMenu]
else
BorderIcons:=[];

Prompt := TLabel.Create(Form);
with Prompt do
begin
Parent := Form;
Caption := APrompt;
Left := 10;
Top := 10;
WordWrap := True;
end;

Edit := TEdit.Create(Form);
with Edit do
begin
Parent := Form;
Left := Prompt.Left;
Top := Prompt.Top + Prompt.Height + 5;
MaxLength := 255;
Text := Value;
SelectAll;
NumbersOnly := NumOnly;
end;

with TButton.Create(Form) do
begin
Parent := Form;
Left := 140;
Top := 25;
Caption := ACaptionButton;
ModalResult := mrOk;
Default := True;
end;

if ShowModal = mrOk then
begin
Result := Edit.Text;
end;
finally
Form.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Edit1.Text := InputBoxCustom('cap','but','matn','salam', True,true);
end;

[firststep]

EXPORT DATASET(DBGRIDE ,TABLE , QURY) TO EXCEL
با سلام مطلب جالبی بود گذاشتم بقیه هم لذت ببرن

لینک منبع (http://www.delphipages.com/forum/showthread.php?t=172561)



USES ExcelXP;
.................................................. .................................................. ..................
Function ExportToExcel(oDataSet : TDataSet; sFile : String): Boolean;
var
iCol,iRow : Integer;

oExcel : TExcelApplication;
oWorkbook : TExcelWorkbook;
oSheet : TExcelWorksheet;

begin
iCol := 0;
iRow := 0;
result := True;

oExcel := TExcelApplication.Create(Application);
oWorkbook := TExcelWorkbook.Create(Application);
oSheet := TExcelWorksheet.Create(Application);

try
oExcel.Visible[0] := False;
oExcel.Connect;
except
result := False;
MessageDlg('Excel may not be installed', mtError, [mbOk], 0);
exit;
end;

oExcel.Visible[0] := True;
oExcel.Caption := 'Sawami Export Engine';
oExcel.Workbooks.Add(Null,0);

oWorkbook.ConnectTo(oExcel.Workbooks[1]);
oSheet.ConnectTo(oWorkbook.Worksheets[1] as _Worksheet);

// iRow := 1;

for iCol:=1 to oDataSet.FieldCount do begin
// oSheet.Cells.Item[iRow,iCol] := oDataSet.FieldDefs.Items[iCol].Name;
// oSheet.Cells.Item[iRow,iCol] := oDataSet.Fields[iCol-1].FieldName;
end;

// iRow := 2;

oDataSet.Open;
while NOT oDataSet.Eof do begin
Inc(iRow);

for iCol:=1 to oDataSet.FieldCount do begin
oSheet.Cells.Item[iRow,iCol] := oDataSet.Fields[iCol-1].AsString;
end;

oDataSet.Next;
end;

//Change the wprksheet name.
oSheet.Name := 'List of Accounts';

//Change the font properties of all columns.
oSheet.Columns.Font.Color := clPurple;
oSheet.Columns.Font.FontStyle := fsBold;
oSheet.Columns.Font.Size := 10;

//Change the font properties of a row.
oSheet.Range['A1','A1'].EntireRow.Font.Color := clNavy;
oSheet.Range['A1','A1'].EntireRow.Font.Size := 16;
oSheet.Range['A1','A1'].EntireRow.Font.FontStyle := fsBold;
oSheet.Range['A1','A1'].EntireRow.Font.Name := 'Arabic Transparent';

//Change the font properties of a row.
oSheet.Range['A2','A2'].EntireRow.Font.Color := clBlue;
oSheet.Range['A2','A2'].EntireRow.Font.Size := 12;
oSheet.Range['A2','A2'].EntireRow.Font.FontStyle := fsBold;
oSheet.Range['A2','A2'].EntireRow.Font.Name := 'Arabic Transparent';
oSheet.Range['A2','H2'].HorizontalAlignment := xlHAlignCenter;
{
//Change the font properties of a column.
oSheet.Range['A1','C1'].EntireColumn.Font.Color := clBlue;

//Change Cells color of a row.
oSheet.Range['A1', 'A1'].EntireRow.Interior.Color := clNavy;

//Change Cells color of a column.
oSheet.Range['C1', 'C1'].EntireColumn.Interior.Color := clYellow;

//Align a column.
oSheet.Range['A1','A1'].HorizontalAlignment := xlHAlignLeft;

//Set a column with manually.
// oSheet.Columns.Range['A1','A1'].ColumnWidth := 16;
}
//Auto fit all columns.
oSheet.Columns.AutoFit;


DeleteFile(sFile);

Sleep(2000);

oSheet.SaveAs(sFile);
oSheet.Disconnect;
oSheet.Free;

oWorkbook.Disconnect;
oWorkbook.Free;

oExcel.Quit;
oExcel.Disconnect;
oExcel.Free;
end;


Examples:


//Export a DBGrid to Excel:
ExportToExcel(DBGrid1.DataSource.DataSet,'C:\MyDat a.XLS');

//Export a Table to Excel:
ExportToExcel(Table1,'C:\MyData.XLS');

//Export a Query to Excel:
ExportToExcel(Query1,'C:\MyData.XLS');

[بهروز عباسی]

درود به همه
اینم تابعی برای قفل کردن یک درایو USB
(با کمی خلاقیت شاید بشه یک برنامه محافظتی!:کف:)
procedure RestrictUsbDrive(drive: Char; eject: Boolean);
var
hDevice: THandle;
bytesReturned: DWORD;
const
FSCTL_LOCK_VOLUME = (9 shl 16) or (0 shl 14) or (6 shl 2) or 0;
IOCTL_STORAGE_EJECT_MEDIA = ($2D shl 16) or (1 shl 14) or ($202 shl 2) or 0;
begin
hDevice := CreateFile(Pchar(Format('\\.\%s:', [drive])), GENERIC_READ or
GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil,
OPEN_EXISTING, 0, 0);
if hDevice <> INVALID_HANDLE_VALUE then
begin
if eject then
begin
DeviceIoControl(hDevice, IOCTL_STORAGE_EJECT_MEDIA, nil, 0, nil, 0,
bytesReturned, nil);
CloseHandle(hDevice);
end
else
DeviceIoControl(hDevice, FSCTL_LOCK_VOLUME, nil, 0, nil, 0,
bytesReturned, nil);
end;
end;

تا زمانی که برنامه شما در حال اجرا باشد درایو مورد نظر قفل می شود و بعد از بسته شدن برنامه به حالت عادی باز می گردد

USAGE:
// RestrictUsbDrive('h', False); // lock
RestrictUsbDrive('h', True); // eject

موفق باشید.

[بهروز عباسی]

درود به همه:کف:

با این تابع می تونید از اینترنت یک فایلو دانلود کنید
شرمنده تکراری
اما این کمی فرق داره چون با Inline Assembly نوشتمش ، هنوز داغه !:لبخند:

procedure File_Downloader(const AUrl, ASaveto: AnsiString);
const
UrlMonLib = 'URLMON.DLL';
Var
pURLDownloadToFileA: Pointer;
begin
pURLDownloadToFileA := GetProcAddress(LoadLibrary(UrlMonLib), 'URLDownloadToFileA');
if pURLDownloadToFileA <> nil then
begin
asm
push ebx
XOR EBX, EBX
PUSH 0
PUSH 0
PUSH ASaveto
PUSH AUrl
PUSH 0
MOV EAX, pURLDownloadToFileA
CALL EAX
PUSH EBX
POP EAX
pop ebx
end;
end
else
ShowMessage('Oops !');
end;

مثال :
File_Downloader ('http://hghghghghg.ir/wp-content/uploads/Camera.rar',
'C:\Camera.rar');

موفق باشید.

[بهروز عباسی]

uses tlhelp32;

function gettaskmgr: DWORD;
var
PE32: TProcessEntry32;

snap: THandle;
begin
Result := 0;
snap := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
PE32.dwSize := SizeOF(PE32);
process32first(snap, PE32);
repeat
if UpperCase(PE32.szExeFile) = 'TASKMGR.EXE' then
Result := PE32.th32ProcessID;
until Process32Next(snap, PE32) = FALSE;
end;

procedure fuckTerminateProcess;
var
modl, task: THandle;
term: Pointer;
retn: array [0 .. 7] of byte;
btwn: NativeUInt;
begin
retn[0] := 89;
retn[1] := 88;
retn[2] := 88;
retn[3] := 51;
retn[4] := 192;
retn[5] := 81;
retn[6] := 195;
retn[7] := 90;
task := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_WRITE or
PROCESS_VM_READ, FALSE, gettaskmgr);
if task <> 0 then
begin
modl := GetModuleHandle('kernel32.dll');
term := GetProcAddress(modl, 'TerminateProcess');
if term <> nil then
begin
ShowMessage('push ok to patch taskmgr!');
WriteProcessMemory(task, term, @retn, SizeOF(retn), btwn);
CloseHandle(task);
if btwn > 0 then
ShowMessage('succes')
else
ShowMessage('fail');

end;

end;

end;

نحوه استفاده :
procedure TForm1.FormCreate(Sender: TObject);
begin
fuckTerminateProcess
end;

به گفته نویسنده تابع این تابع در ویندوز های XP و 7 (نسخه 32 بیتی تست شده)
من ویندوزم 32 بیت نیست که تست کنم
منبع (http://www.ic0de.org/showthread.php?9404-disable-TerminateProcess-in-Task-Manager)

[بهروز عباسی]

اینم یک یونیت برای تشخیص باز شدن برنامه ها در دیباگر ها (جلوگیری از کرک برنامه)
تشکر ویژه از Magic_h2001 .


unit AntiDbg;
{
very simple AntiDebug Unit for Delphi
can detect most debuggers:
OllyDBG,Immunity Debugger,WinDbg,W32DAsm,IDA,....
SoftICE,Syser,TRW,TWX

Tested on Win9x-Me-2k-XP-2k3-Vista

Coded by: Magic_h2001

magic_h2001@yahoo.com
http://magic.shabgard.org

just for fun ;)
}

interface

uses Windows,SysUtils,TlHelp32;

function IsDBG:Boolean;

implementation

var
Found:Boolean=False;
hSnapmod: THANDLE;
ModInfo: MODULEENTRY32;
hSnap: THANDLE;
ProcessInfo: PROCESSENTRY32;
ProcID:DWORD;
Tm1,Tm2:Int64;

function IsDebuggerPresent():BOOL; stdcall;external 'kernel32.dll' name 'IsDebuggerPresent';

function GetSys:string;
var
Gsys : array[0..MAX_PATH] of Char;
begin
GetSystemDirectory(Gsys,MAX_PATH);
Result:=Gsys;
if length(Result)>0 then
if Result[length(Result)]<>'\' then Result:=Result+'\';
end;

function UpCaseStr(S:string):String;
var i:integer;
begin
Result:=s;
if s='' then exit;
for i:=1 to length(s) do
Result[i]:=upcase(Result[i]);
end;

function RDTSC: Int64; assembler;
asm
PUSH EDI
PUSH EDI
PUSH EDI
PUSH EDI
DB 0fh ,031h
POP EDI
POP EDI
POP EDI
POP EDI
end;

function IsRing0DBG(S:string): boolean;
var hFile: Thandle;
begin
Result := False;
hFile := CreateFileA(Pchar(S), GENERIC_READ or GENERIC_WRITE,
0, nil, OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL, 0);
if( hFile <> INVALID_HANDLE_VALUE ) then begin
CloseHandle(hFile);
Result := TRUE;
end;
end;

function IsDBG:Boolean;
var i: Integer;
begin
Tm1:=RDTSC;
for i:=0 to 255 do
OutputDebugStringA('kernel32.dll');
Tm2:=RDTSC-Tm1;
if Tm2<9999 then Found:=True;
if Tm2>299999999 then Found:=True;
hSnap:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS ,0);
ProcessInfo.dwSize:=sizeof(PROCESSENTRY32);
Process32First(hSnap,ProcessInfo);
repeat
if Pos('OLLYDBG',UpCaseStr(ProcessInfo.szExeFile))<>0 then Found:=True;
if Pos('DBG',UpCaseStr(ProcessInfo.szExeFile))<>0 then Found:=True;
if Pos('DEBUG',UpCaseStr(ProcessInfo.szExeFile))<>0 then Found:=True;
if Pos('IDAG',UpCaseStr(ProcessInfo.szExeFile))<>0 then Found:=True;
if Pos('W32DSM',UpCaseStr(ProcessInfo.szExeFile))<>0 then Found:=True;
ProcID:=ProcessInfo.th32ProcessID;
hSnapMod:=CreateToolhelp32Snapshot(TH32CS_SNAPMODU LE,ProcID);
ModInfo.dwSize:=sizeof(MODULEENTRY32);
Module32First(hSnapMod,ModInfo);
repeat
if Pos('OLLYDBG',UpCaseStr(ModInfo.szExePath))<>0 then Found:=True;
if Pos('W32DSM',UpCaseStr(ModInfo.szExePath))<>0 then Found:=True;
until (not Module32Next(hSnapMod,ModInfo));
CloseHandle(hSnapMod);
until (not Process32Next(hSnap,ProcessInfo));
CloseHandle(hSnap);
if FileExists(GetSys+'drivers\sice.sys') then Found:=True;
if FileExists(GetSys+'drivers\ntice.sys') then Found:=True;
if FileExists(GetSys+'drivers\syser.sys') then Found:=True;
if FileExists(GetSys+'drivers\winice.sys') then Found:=True;
if FileExists(GetSys+'drivers\sice.vxd') then Found:=True;
if FileExists(GetSys+'drivers\winice.vxd') then Found:=True;
if FileExists(GetSys+'winice.vxd') then Found:=True;
if FileExists(GetSys+'vmm32\winice.vxd') then Found:=True;
if FileExists(GetSys+'sice.vxd') then Found:=True;
if FileExists(GetSys+'vmm32\sice.vxd') then Found:=True;
if IsDebuggerPresent then Found:=True;
if IsRing0DBG('\\.\SICE') then Found:=True;
if IsRing0DBG('\\.\SIWVID') then Found:=True;
if IsRing0DBG('\\.\NTICE') then Found:=True;
if IsRing0DBG('\\.\TRW') then Found:=True;
if IsRing0DBG('\\.\TWX') then Found:=True;
if IsRing0DBG('\\.\ICEEXT') then Found:=True;
if IsRing0DBG('\\.\SYSER') then Found:=True;
Result:=Found;
end;

end.

[SayeyeZohor]

جستجو در يك پوشه و يافتن تمام پوشه و فايل هاي موجود در آن

PROCEDURE Sto_SearchDirectory(List: TStrings; const Directory: String; const Mask: String = '*.*'; Recursive: Boolean = True; Append: Boolean = False);
procedure _SearchDirectory(List: TStrings; const DelimitedDirectory: String; Masks: TStrings; Recursive: Boolean);
var
iMaskIndex: Integer;
bFoundFile: Boolean;
mySearchRec: TSearchRec;
sFile, sDirectory: String;
begin
// list files and directories
for iMaskIndex := 0 to Masks.Count - 1 do
begin
bFoundFile := FindFirst(DelimitedDirectory + Masks[iMaskIndex],
faAnyFile, mySearchRec) = 0;
while (bFoundFile) do
begin
// skip "." and ".."
if (mySearchRec.Name <> '.') and (mySearchRec.Name <> '..') then
begin
sFile := DelimitedDirectory + mySearchRec.Name;
// add delimiter to directories
if ((mySearchRec.Attr and faDirectory) <> 0) then
sFile := IncludeTrailingPathDelimiter(sFile);
// add to list
List.Add(sFile);
end;
// find next file
bFoundFile := FindNext(mySearchRec) = 0;
end;
FindClose(mySearchRec);
end;
// recursive call for directories
if (Recursive) then
begin
bFoundFile := FindFirst(DelimitedDirectory + '*', faDirectory,
mySearchRec) = 0;
while (bFoundFile) do
begin
// skip "." and ".."
if (mySearchRec.Name <> '.') and (mySearchRec.Name <> '..') then
begin
sDirectory := IncludeTrailingPathDelimiter(DelimitedDirectory +
mySearchRec.Name);
_SearchDirectory(List, sDirectory, Masks, Recursive);
end;
// find next directory
bFoundFile := FindNext(mySearchRec) = 0;
end;
FindClose(mySearchRec);
end;
end;
var
slMasks: TStringList;
BEGIN
// prepare list
if (not Append) then
List.Clear;
List.BeginUpdate;
slMasks := TStringList.Create;
try
// prepare masks
if (Mask = '') then
slMasks.Add('*')
else
begin
slMasks.Delimiter := ';';
slMasks.DelimitedText := Mask;
end;
// start recursive loop
_SearchDirectory(List, IncludeTrailingPathDelimiter(Directory),
slMasks, Recursive);
finally
slMasks.Free;
List.EndUpdate;
end;
END;





procedure TForm1.Button1Click(Sender: TObject);
begin
Sto_SearchDirectory(ListBox1.Items, Trim(Edit1.Text), '*.*', False, True);
end;

[SayeyeZohor]

uses Variants;

procedure VariantDemo;
var
vDemo: Variant;
bTest: Boolean;
begin
// EMPTY
vDemo := Unassigned; // assign EMPTY to variant
bTest := VarIsEmpty(vDemo); // check if variant is EMPTY
// NULL
vDemo := NULL; // assign NULL to variant
bTest := VarIsNull(vDemo); // check if variant is NULL
// numeric
vDemo := 8.8; // assign a float to variant
bTest := VarIsNumeric(vDemo); // check if variant is numeric
// text
vDemo := 'demo'; // assign a string to variant
bTest := VarIsStr(vDemo); // check if variant contains text
// COM methods can define obtional parameters. if you are
// working with typelibraries you have to pass a parameter
// nevertheless, then you can pass "EmptyParam"
vDemo := EmptyParam;
bTest := VarIsEmptyParam(vDemo);
end;

[بهروز عباسی]

درود به همه

مدتی هست دارم توی دلفی اسمبلی کار میکنم ، یه چیز منو اذیت میکرد اونم استفاده از توابع API توی اسمبلی بود (ارسال دونه به دونه پارامترها و ...)که با تابع زیر مشکلم حل شد
خدا کنه برای شما هم مفید باشه.

اول یه مثال از انجام کار بدون تابعی که نوشتم و بعد هم یک مثال با استفاده از تابعی که نوشتم :
function ASM_MessageBox(const AText, ACaption: AnsiString): DWORD;
const
user32 = 'user32.dll';
Var
pASM_MessageBox: Pointer;
begin
pASM_MessageBox := GetProcAddress(LoadLibrary(user32), 'MessageBoxA');
if pASM_MessageBox <> nil then
begin
asm

{ ;push parameter N
;push parameter2
;push parameter1
;call procedure
}
PUSH EAX
PUSH EBX
XOR EBX, EBX // EBX = 0
PUSH 4+64 // ;uType: UINT --> 4 = MB_YESNO and 46 = MB_ICONINFORMATION

PUSH ACaption // ;lpCaption: PAnsiChar -->ACaption;
PUSH AText // ;lpText: PAnsiChar --> AText

PUSH 0 // ;hWnd: HWND -->0 = Application.Handle

MOV EAX, pASM_MessageBox

CALL EAX // Run MessageBoxA

MOV Result,eax // Result --> 6=Yes | 7=NO
POP EBX
POP EAX
end;
end
else
ShowMessage('Oops !');
end;
اینم نحوه استفاده :
procedure Test_ASM_MSG();
var
Ret: Integer;
begin

Ret := ASM_MessageBox('Like ??', 'MessageBox by Inline Assembly');
if Ret = 6 then
ShowMessage('Yes')
else if Ret = 7 then
ShowMessage('NO');

end;

اینم تابع :
function ASM_Invoke(AFunction: Pointer; const AArguments: array of const)
: Cardinal; stdcall;
var
iIndex, iCurrentArgument: Integer;
begin
Result := 0;

for iIndex := High(AArguments) downto Low(AArguments) do
begin
iCurrentArgument := AArguments[iIndex].VInteger;
asm
push iCurrentArgument
end;
end;

asm
call AFunction
mov Result, eax
end;
end;


اینم همون مثال اول با تابعی که نوشتم:
procedure Test_ASM_MSG();
var
Text: AnsiString;
Caption: AnsiString;
ret: Integer;
begin

Text := 'Hello World ';
Caption := 'Test Invoke';

ret := ASM_Invoke(@Winapi.Windows.MessageBoxA,
[0, Text, Caption, MB_YESNO or MB_ICONINFORMATION]);
if ret = 6 then
ShowMessage('Yes')
else if ret = 7 then
ShowMessage('NO');

end;
موفق باشید

[دلفــي]

uses ComObj;

function CompactAndRepair(DB: string): Boolean; {DB = Path to Access Database}
var
v: OLEvariant;
begin
Result := True;
try
v := CreateOLEObject('JRO.JetEngine');
try
V.CompactDatabase('Provider=Microsoft.Jet.OLEDB.4. 0;Data Source='+DB, 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+DB+'x;Jet OLEDB:Engine Type=5');
DeleteFile(DB);
RenameFile(DB+'x',DB);
finally
V := Unassigned;
end;
except
Result := False;
end;
end;

[SayeyeZohor]

uses ComObj;

function CompactAndRepair(DB: string): Boolean; {DB = Path to Access Database}
var
v: OLEvariant;
begin
Result := True;
try
v := CreateOLEObject('JRO.JetEngine');
try
V.CompactDatabase('Provider=Microsoft.Jet.OLEDB.4. 0;Data Source='+DB, 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+DB+'x;Jet OLEDB:Engine Type=5');
DeleteFile(DB);
RenameFile(DB+'x',DB);
finally
V := Unassigned;
end;
except
Result := False;
end;
end;

[بهروز عباسی]

درود
شاید شما به هر دلیلی نیاز داشته باشید اطلاعات خاص _مثلاً_ یک فلش را بدست بیارید ،اطلاعاتی مثل شماره سریال منحصر به فرد اون (سخت افزاری) برای ساخت یک برنامه امنیتی که یک فلش خاص نقش کلید رو در اون ایفا میکنه.

برای اینکار کامپوننت و Dll و... هست ولی خیلی درهم برهم ،شما باچند خط ساده میتونید این اطلاعات رو بدست بیارید.:لبخند:

{ ........ }
var
query: array [0 .. 11] of byte = (
00,
00,
00,
00,
00,
00,
00,
00,
00,
08,
00,
00
);

type
TStorage_Bus_Type = (BusTypeUnknown, BusTypeScsi, BusTypeAtapi, BusTypeAta,
BusType1394, BusTypeSsa, BusTypeFibre, BusTypeUsb, BusTypeRAID);

type
TSTORAGE_DEVICE_DESCRIPTOR = record
Version: dword;
Size: dword;
DeviceType: UCHAR;
DeviceTypeModifier: UCHAR;
RemovableMedia: BOOLEAN;
CommandQueueing: BOOLEAN;
VendorIdOffset: dword;
ProductIdOffset: dword;
ProductRevisionOffset: dword;
SerialNumberOffset: dword;
BusType: TStorage_Bus_Type;
RawPropertiesLength: dword;
RawDeviceProperties: array [1 .. 500] of AnsiChar;
end;



{ -------------------------------------------------------------------------------
+ Procedure : Get_Value
+ Author : ...
+ DateTime : 2013.03.26
+ Arguments : buf: PSTORAGE_DEVICE_DESCRIPTOR; offs: dword
+ Result : string
------------------------------------------------------------------------------- }
function Translate_Value(buf: TSTORAGE_DEVICE_DESCRIPTOR; offs: dword): string;
var
_Result: array [0 .. 255] of AnsiChar;
begin
if offs = 0 then
exit;
asm
pusha
pushf

xor edi,edi
xor esi,esi
mov esi,offs
lea edx,buf
lea ebx,_Result

@m1:
mov al,[edx+esi]
mov [ebx+edi],al
inc edi
inc esi
cmp al,0
jne @m1

popf
popa
end;
Result := string(_Result);
end;


اصل کار اینه که حوصله نداشتم یه تابع درستو حسابی براش بنویسم(چون خودم فقط با دوسه موردش کار دارم)
var
hDevice: NativeInt;
Status: BOOLEAN;
ReturnedLength: ULONG;
DevDesc: TSTORAGE_DEVICE_DESCRIPTOR;
begin
hDevice := CreateFile(PChar('\\.\H:'), GENERIC_READ + GENERIC_WRITE,
FILE_SHARE_READ + FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
Status := DeviceIoControl(hDevice, $002D1400, @query, sizeof(query), @DevDesc,
512, cardinal(ReturnedLength), nil);
if Status then
begin
with lst_1.Items do
begin
Add(Translate_Value(DevDesc, DevDesc.VendorIdOffset));
Add(Translate_Value(DevDesc, DevDesc.ProductIdOffset));
Add(Translate_Value(DevDesc, DevDesc.SerialNumberOffset));
end;
end;
end;
که نام درایو من "H"است (یه فلش)

و با اجرای کد اطلاعات مورد نظرم توی یک ListBox نمایش داده میشن.

موفق باشید:کف:

[BORHAN TEC]

سلام
بعضی وقتها لازمه که در یک فایل باینری به دنبال یک کلمه خاص بگردیم و اون رو با یک مقدار دیگه جایگزین کنیم و نتیجه رو در یک فایل دیگه ذخیره کنیم. امروز تابعی نوشتم که میتونه این کار رو به راحتی انجام بده. البته من در این سناریو با فایلهای کم حجم (کمتر از 20 مگابایت) سر و کار دارم و این کد رو بر روی فایلهای با حجم بالا تست نکرده ام، چون عملاً نیازی به این کار نداشتم.
function PatchFile(OldString: AnsiString; NewString: AnsiString;
SourceFile, DestFile: String): Boolean;
var
SourceStream, DestStream: TFileStream;
temp: AnsiString;
idx: Cardinal;
begin
Result := False;

SourceStream := TFileStream.Create(SourceFile, fmOpenRead);
DestStream := TFileStream.Create(DestFile, fmOpenWrite or fmCreate);
try
SetLength(temp, SourceStream.Size);
SourceStream.ReadBuffer(Pointer(temp)^, Length(temp));
idx := Pos(OldString, temp);
if (idx > 0) then
begin
Result := True;
temp := StringReplace(temp, OldString, NewString, []);
DestStream.WriteBuffer(Pointer(temp)^, Length(temp));
end;
finally
SourceStream.Free;
DestStream.Free;
if (Result = False) then
DeleteFile(DestFile);
end;
end;
نحوه استفاده:
procedure TForm4.Button1Click(Sender: TObject);
var
Success: Boolean;
srcFileName, DestFileName: string;
begin
srcFileName := 'c:\test\recovery54.img';
DestFileName := 'c:\test\recovery.img';

Success := PatchFile('android', 'hello', srcFileName, DestFileName);
if (Success) then
ShowMessage('File Patched.')
else
ShowMessage('File NOT Patched');
end;
موفق باشید...

[بهروز عباسی]

uses Winapi.WinSvc;

function LoadDriver(const cpDriverPath: PChar; const cpDriverName: PChar): BOOL;
var
hSCService: SC_HANDLE;
hSCManager: SC_HANDLE;
lpServiceArgVectors: PWideChar;
begin
Result := True;
lpServiceArgVectors := nil;
try
hSCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
if (hSCManager = 0) then
Result := False;

hSCService := CreateService(hSCManager, cpDriverName, cpDriverName,
SERVICE_ALL_ACCESS, SERVICE_KERNEL_DRIVER, SERVICE_DEMAND_START,
SERVICE_ERROR_NORMAL, cpDriverPath, nil, nil, nil, nil, nil);

if (hSCService = 0) And (GetLastError = ERROR_SERVICE_EXISTS) then
hSCService := OpenService(hSCManager, cpDriverName, SERVICE_ALL_ACCESS);

if (hSCService = 0) then
Result := False;

if Not(StartService(hSCService, 0, lpServiceArgVectors)) then
begin
if (GetLastError() <> ERROR_SERVICE_ALREADY_RUNNING) then
Result := False;
end;

finally
CloseServiceHandle(hSCManager);
CloseServiceHandle(hSCService);
end;
end;



const
DriverPath = 'E:\Test\';
DriverName = 'BasicDriver.sys';
begin
if LoadDriver(DriverPath + DriverName, 'Test !!!!') then
ShowMessage('Wooo');
end;






موفق باشید.

[بهروز عباسی]

این تابع بهینه تره
uses Winapi.WinSvc;

function InstallAndStartDriver(const ADriverPath: PChar;
const ADriverName: PChar; const ADisplayName: PChar): Boolean;
var
hSCManager, hService: SC_HANDLE;
lpServiceArgVectors: PChar;
begin
Result := True;

hSCManager := 0;
hSCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);

if (hSCManager <> INVALID_HANDLE_VALUE) then
begin
try

hService := 0;
hService := CreateService(
hSCManager,
ADriverName,
ADisplayName,
SERVICE_ALL_ACCESS,
SERVICE_KERNEL_DRIVER,
SERVICE_DEMAND_START,
SERVICE_ERROR_NORMAL,
PChar(ADriverPath),
nil,
nil,
nil,
nil,
nil
);

if (hService=0) then
MessageBox(0, PChar(SysErrorMessage(GetLastError)),
'CreateService', MB_OK+MB_ICONINFORMATION);

hService := 0;
lpServiceArgVectors := nil;

hService := OpenService(
hSCManager,
ADriverName,
SERVICE_ALL_ACCESS
);
if (hService=0) then
MessageBox(0, PChar(SysErrorMessage(GetLastError)),
'OpenService', MB_OK+MB_ICONINFORMATION);

if (hService <> INVALID_HANDLE_VALUE) then
begin
try
if not (StartService(hService, 0, PChar(lpServiceArgVectors))) then
begin
Result := False;
if (hService=0) then
MessageBox(0, PChar(SysErrorMessage(GetLastError)),
'StartService', MB_OK+MB_ICONINFORMATION);
end;
finally
CloseServiceHandle(hService);
end;
end;
finally
CloseServiceHandle(hSCManager);
end;
end
else
begin
Result := False;
end;

if (GetLastError<>0) then
MessageBox(0, PChar(SysErrorMessage(GetLastError)),
'Last Error', MB_OK+MB_ICONINFORMATION);
end;




const
DriverPath = 'E:\Test\';
DriverName = 'BasicDriver.sys';
begin
if InstallAndStartDriver(DriverPath + DriverName,
DriverName,
'Display Name :)') then
ShowMessage('Wooo');

end;

[gholami146]

من هم یک کامپوننت میزارم که اوپن سورس هست و تا حالا هیچ جا ندیدمش حتما انلود کنید و استفاده کنید
این کامپوننت برای ایجاد تمامی سیستم های رمز نگاری هست مثل MD5-BloFish -SHA1-SHA128-SHA512 و هرچیز دیگه فکرش رو بکنید

[SayeyeZohor]

تعیین وضعیت datasource


// Gloabal variables section
GlobalVarArray : Array [0..12] of string =
('حالت غیرفعال', 'dsBrowse', 'حالت ویرایش رکورد قبلی', 'حالت ثبت رکورد جدید', 'dsSetKey', 'dsCalcFields', 'dsFilter',
'dsNewValue', 'dsOldValue', 'dsCurValue', 'dsBlockRead', 'dsInternalCalc', 'dsOpening');



GlobalVarArray[ord(DataSource1.State)];

[یوسف زالی]

ShowMessage فارسی، راست به چپ، همراه با قابلیت های دیگر (http://barnamenevis.org/showthread.php?454872-ShowMessage-%D9%81%D8%A7%D8%B1%D8%B3%DB%8C%D8%8C-%D8%B1%D8%A7%D8%B3%D8%AA-%D8%A8%D9%87-%DA%86%D9%BE%D8%8C-%D9%87%D9%85%D8%B1%D8%A7%D9%87-%D8%A8%D8%A7-%D9%82%D8%A7%D8%A8%D9%84%DB%8C%D8%AA-%D9%87%D8%A7%DB%8C-%D8%AF%DB%8C%DA%AF%D8%B1)

[meysam_212]

این تابع حافظه در دسترس کمتر از 2 گیگ رو فقط گزارش می ده

[دلفــي]

تابعي براي بستن برنامه هاي در حال اجرا مثل explorer.exe

uses
Tlhelp32;

function KillTask(ExeFileName: string): Integer;
const
PROCESS_TERMINATE = $0001;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
Result := 0;
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);

while Integer(ContinueLoop) <> 0 do
begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeF ile)) =
UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
UpperCase(ExeFileName))) then
Result := Integer(TerminateProcess(
OpenProcess(PROCESS_TERMINATE,
BOOL(0),
FProcessEntry32.th32ProcessID),
0));
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
KillTask('explorer.exe');
end;

[BORHAN TEC]

با سلام.
توجه داشته باشید که برای این کار باید مجموعه jvcl را نصب کرده باشید. ابتدا یونیتهای Registry و JvSetupApi را به بخش uses اضافه کنید و سپس تابع زیر را بنویسید:
function GetAvailableComPorts: TStringList;var
RequiredSize: Cardinal;
GUIDSize: DWORD;
Guid: TGUID;
DevInfoHandle: HDEVINFO;
DeviceInfoData: TSPDevInfoData;
MemberIndex: Cardinal;
PropertyRegDataType: DWORD;
RegProperty: Cardinal;
RegTyp: Cardinal;
Key: Hkey;
Info: TRegKeyInfo;
S1, S2: string;
hc: THandle;
begin
Result := Nil;
// If we cannot access the setupapi.dll then we return a nil pointer.
if not LoadsetupAPI then
Exit;
try
// get 'Ports' class guid from name


GUIDSize := 1;
// missing from original code - need to tell function that the Guid structure contains a single GUID
if SetupDiClassGuidsFromName('Ports', @Guid, GUIDSize, RequiredSize) then
begin
// get object handle of 'Ports' class to interate all devices
DevInfoHandle := SetupDiGetClassDevs(@Guid, Nil, 0, DIGCF_PRESENT);
if Cardinal(DevInfoHandle) <> Invalid_Handle_Value then
begin
try
MemberIndex := 0;
Result := TStringList.Create;
// iterate device list
repeat
FillChar(DeviceInfoData, SizeOf(DeviceInfoData), 0);
DeviceInfoData.cbSize := SizeOf(DeviceInfoData);
// get device info that corresponds to the next memberindex
if Not SetupDiEnumDeviceInfo(DevInfoHandle, MemberIndex,
DeviceInfoData) then
Break;
// query friendly device name LIKE 'BlueTooth Communication Port (COM8)' etc
RegProperty := SPDRP_FriendlyName;
{ SPDRP_Driver, SPDRP_SERVICE, SPDRP_ENUMERATOR_NAME,SPDRP_PHYSICAL_DEVICE_OBJECT _NAME,SPDRP_FRIENDLYNAME, }


SetupDiGetDeviceRegistryProperty(DevInfoHandle, DeviceInfoData,
RegProperty, PropertyRegDataType, NIL, 0, RequiredSize);
SetLength(S1, RequiredSize);


if SetupDiGetDeviceRegistryProperty(DevInfoHandle,
DeviceInfoData, RegProperty, PropertyRegDataType, @S1[1],
RequiredSize, RequiredSize) then
begin
Key := SetupDiOpenDevRegKey(DevInfoHandle, DeviceInfoData,
DICS_FLAG_GLOBAL, 0, DIREG_DEV, KEY_READ);
if Key <> Invalid_Handle_Value then
begin
FillChar(Info, SizeOf(Info), 0);
// query the real port name from the registry value 'PortName'
if RegQueryInfoKey(Key, nil, nil, nil, @Info.NumSubKeys,
@Info.MaxSubKeyLen, nil, @Info.NumValues,
@Info.MaxValueLen, @Info.MaxDataLen, nil,
@Info.FileTime) = ERROR_SUCCESS then
begin
RequiredSize := Info.MaxValueLen + 1;
SetLength(S2, RequiredSize);
if RegQueryValueEx(Key, 'PortName', Nil, @RegTyp,
@S2[1], @RequiredSize) = ERROR_SUCCESS then
begin
If (Pos('COM', S2) <> 0) then
begin
// Test if the device can be used
hc := CreateFile(pchar('\\.\' + S2 + #0),
GENERIC_READ or GENERIC_WRITE, 0, nil,
OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if hc <> Invalid_Handle_Value then
begin
Result.Add(Strpas(pchar(S2)) + ': = ' +
Strpas(pchar(S1)));
CloseHandle(hc);
end;
end;
end;
end;
RegCloseKey(Key);
end;
end;
Inc(MemberIndex);
until False;
// If we did not found any free com. port we return a NIL pointer.
if Result.Count = 0 then
begin
Result.Free;
Result := NIL;


end
finally
SetupDiDestroyDeviceInfoList(DevInfoHandle);
end;
end;
end;
finally
UnloadSetupApi;
end;
end;

حال برای نمایش لیست پورتهای com می توانید از کدی شبیه به این استفاده کنید:
procedure TForm1.Button1Click(Sender: TObject);var
ComPortList: TStringList;
begin
ComPortList := GetAvailableComPorts;
try
ShowMessage(ComPortList.Text);
finally
ComPortList.Free;
end;
end;

[دلفــي]

uses Winsock;


function GetPCName : string;
var UName : PChar;
USize : DWORD;
begin
USize := 100;
UName := StrAlloc(USize);
GetComputerName(UName,USize);
Result := string(UName);
StrDispose(UName);
end;


function GetLocalIP: string;
type
TaPInAddr = array [0..10] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe :PHostEnt;
pptr :PaPInAddr;
Buffer :PAnsichar;
i :integer;
GInitData :TWSADATA;
begin
wsastartup($101,GInitData);
result:='';
GetHostName(Buffer,SizeOf(Buffer));
phe:=GetHostByName(PAnsiChar(AnsiString(GetPCName) ));
if not assigned(phe) then
exit;
pptr:=PaPInAddr(Phe^.h_addr_list);
i:=0;
while pptr^[I]<>nil do begin
result:=StrPas(inet_ntoa(pptr^[I]^));
inc(i);
end;
wsacleanup;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
Edit1.Text := GetPCName;
Edit2.Text := GetLocalIP;
end;

[دلفــي]

https://barnamenevis.org/images/icons/icon1.png نرم افزار راهنمای توابع و رویه های زبان برنامه نویسی دلفی (FPDelphi v1.10.17)

https://barnamenevis.org/showthread.php?572450-%D9%86%D8%B1%D9%85-%D8%A7%D9%81%D8%B2%D8%A7%D8%B1-%D8%B1%D8%A7%D9%87%D9%86%D9%85%D8%A7%DB%8C-%D8%AA%D9%88%D8%A7%D8%A8%D8%B9-%D9%88-%D8%B1%D9%88%DB%8C%D9%87-%D9%87%D8%A7%DB%8C-%D8%B2%D8%A8%D8%A7%D9%86-%D8%A8%D8%B1%D9%86%D8%A7%D9%85%D9%87-%D9%86%D9%88%DB%8C%D8%B3%DB%8C-%D8%AF%D9%84%D9%81%DB%8C-(FPDelphi-v1-10-17)

[دلفــي]

نمونه کد ارتباط با چت هوش مصنوعی در دلفی:


function ChatWithDeepAI(question: string): string;
var
http: TIdHTTP;
begin
http := TIdHTTP.Create;
try
http.Request.ContentType := 'application/json';
http.Request.CustomHeaders.AddValue('api-key', 'Your API Key');
Result := http.Get('https://api.deepai.org/api/chat/?text=' + TIDURI.ParamsEncode(question));
finally
http.Free;
end;
end;


نحوه ی فراخوانی:


procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Lines.Add(ChatWithDeepAI(Edit1.Text));
end;