تیرماه 87 - کدهای آماده دلفی

دانش خود را نادانى میانگارید ، و یقین خویش را گمان مپندارید ، و چون دانستید دست به کار آرید ، و چون یقین کردید پاى پیش گذارید . [نهج البلاغه]

کدهای آماده دلفی

پست الکترونیک

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


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

function MatchStrings(source, pattern: String): Boolean;
 var
   pSource: array [0..255] of Char;
   pPattern: array [0..255] of Char;

   function MatchPattern(element, pattern: PChar): Boolean;

     function IsPatternWild(pattern: PChar): Boolean;
     var
       t: Integer;
     begin
       Result := StrScan(pattern,"*") <> nil;
       if not Result then Result := StrScan(pattern,"?") <> nil;
     end;

   begin
     if 0 = StrComp(pattern,"*") then
       Result := True
     else if (element^ = Chr(0)) and (pattern^ <> Chr(0)) then
       Result := False
     else if element^ = Chr(0) then
       Result := True
     else begin
       case pattern^ of
       "*": if MatchPattern(element,@pattern[1]) then
              Result := True
            else
              Result := MatchPattern(@element[1],pattern);
       "?": Result := MatchPattern(@element[1],@pattern[1]);
       else
         if element^ = pattern^ then
           Result := MatchPattern(@element[1],@pattern[1])
         else
           Result := False;
       end;
     end;
   end;

 begin
   StrPCopy(pSource,source);
   StrPCopy(pPattern,pattern);
   Result := MatchPattern(pSource,pPattern);
 end;

محمد مقصودلو ::: سه شنبه 87/4/25::: ساعت 11:37 صبح

نظرات دیگران: نظر

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

uses


ComObj;


function CompactAndRepair(DB: string): Boolean; {DB = Path to Access Database}
var
  v: OLEvariant;
begin
  Result := True;
try
  v := CreateOLE("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;

محمد مقصودلو ::: سه شنبه 87/4/25::: ساعت 11:36 صبح

نظرات دیگران: نظر

کپی کردن یک فایل

با استفاده از این تابع می توانید یک فایل را به وسیله آدرس دهی مکان جاری و مکانی که می خواهید این فایل را در آن کپی کنید استفاده نمایید

{This way uses a File stream.}

Procedure FileCopy( Const sourcefilename, targetfilename: String );

Var

S, T: TFileStream;

Begin

S := TFileStream.Create( sourcefilename, fmOpenRead );

try

T := TFileStream.Create( targetfilename,

fmOpenWrite or fmCreate );

try

T.CopyFrom(S, S.Size ) ;

finally

T.Free;

end;

finally

S.Free;

end;

End

محمد مقصودلو ::: دوشنبه 87/4/24::: ساعت 9:29 صبح

نظرات دیگران: نظر

کپی کردن تاریخ یک فایل بر اساس تاریخ یک فایل دیگر

کپی کردن تاریخ یک فایل بر اساس تاریخ یک فایل دیگر

procedure CopyFileDate(const Source, Dest: String);
var
  SourceHand, DestHand: word;
begin
  SourceHand := FileOpen(Source, fmOutput);       { open source file }
 
  DestHand := FileOpen(Dest, fmInput);            { open dest file }
  FileSetDate(DestHand, FileGetDate(SourceHand)); { get/set date }
  FileClose(SourceHand);                          { close source file }
  FileClose(DestHand);                            { close dest file }
end
برگرفته شده از سایت دنیای برنامه نویسی دلفی(http://mt85.blogfa.com)

محمد مقصودلو ::: دوشنبه 87/4/24::: ساعت 9:17 صبح

نظرات دیگران: نظر

گرفتن سایز یک فایل روی هارد دیسک

function GetFileSizeOnDisk(const FileName: TFileName): Cardinal;

var

spc,bps,nofc,tnoc : Cardinal;

ClusterSize,

ClustersCount,

FileSize : Cardinal;

begin

Result := 0;

if not FileExists(FileName) then

Exit;

//Call GetDiskFreeSpace to find out disk cluster size.

if not GetDiskFreeSpace(PAnsiChar(ExtractFileDrive(FileNa me)),spc,bps,nofc,tnoc) then

Exit;

//Cluster size = Bytes Per Sector * Sectors Per Cluster

ClusterSize := bps * spc;

//Get actual file size.

FileSize := GetCompressedFileSize(PAnsiChar(FileName),nil);

ClustersCount := FileSize div ClusterSize;

//Calculate file size on the disk.

Result := ClustersCount * ClusterSize;

//if the file occupies a cluster partially, add cluster size to file size, because

//a cluster is the smallest unit of disk which is accesible.

if FileSize > Result then

Inc(Result,ClusterSize);

end;

برگرفته شده از سایت دنیای برنامه نویسی دلفی(http://mt85.blogfa.com)

محمد مقصودلو ::: دوشنبه 87/4/24::: ساعت 9:15 صبح

نظرات دیگران: نظر

< 1 2 3 4

لیست کل یادداشت های این وبلاگ

بهترین کامپوننت تاریخ شمسی در دلفی 7
یک ساعت فوق العاده
اضافه کردن زبان فارسی به ویندوز XP
یک Message Dialog با امکان تغییر نوشته ی دکمه و تمام قسمتها
بستن پنجره
پاک کردن برنامه به وسیله ی خودش
دانلود کردن سورس یک سایت
بدست آوردن آدرس جاری IE
پاک کردن آدرسهای IE
آموزش کار با IntraWeb در دلفی
مبدل ها
تصویر به bmp2icon) Icon)
تشخیص اینکه HARD DISK ما چند درایو دارد.
اینم یک برنامه ای که ICON درایوها را تغییر می دهد.
درست کردن فیلتر زرد رنگ روی ایمیج
[همه عناوین(126)][عناوین آرشیوشده]

>> بازدیدهای وبلاگ <<

بازدید امروز: 34

بازدید دیروز: 42

کل بازدید :88509

>> درباره خودم <<

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

>>تست سرعت تایپ<<

9 کلمه

Speed test

>> پیوندهای روزانه <<