Live Chat Software
Emre CIRIK | Text Dosya birleştirici ( Text File Joiner )

Text Dosya birleştirici ( Text File Joiner )

by EMRCRK 28. April 2011 12:41

Merhaba arkadaşlar,size çok basit bir programdan bahsediceğim. Konu başlığındada belirtildiği gibi text dosya birleştirici. Arkadaşlar bu programa nasıl ihtiyaç duydum bugün müşterimde 105 adet text dosyada sayım bilgileri mevcuttu ve bunları tek dosyada birleştirmem gerekiyordu. Çok kolay bir program diye google dan aradım ve buldum programı. Kurdum daha sonra bir baktım ki program ücretli . Dedim nasıl olur bu programı satın alırlarmı ki alıyolarmış :) Şimdi biz bu programı cracklermiydik evet ama gerek yok. Oturup program yazmak hem ahlaki açıdan hemde bizim açımızdan daha iyidir. 

Normal şartlarda .NET platformu ile yazabileceğimiz bu porgramı bu sefer Delphi 7 de hazırladık. Çünkü Delphi ile daha hızlı programlar hazırlaya biliyorsunuz. Nuh hocam bu işi üstlendi ve tamı tamına 2 dk gibi kısa bir sürede programı hazırladı. 

 

TextBirlesTirme.rar (168,71 kb)

 

 

 


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Edit1: TEdit;
    Button2: TButton;
    Memo2: TMemo;
    Memo3: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
Procedure FindFiles(const Path, Mask: string; IncludeSubDir: boolean; Out List:TStringList);
var
  FindResult: integer;
  SearchRec : TSearchRec;
begin
  FindResult := FindFirst(Path + Mask, faAnyFile - faDirectory, SearchRec);
  while FindResult = 0 do
  begin
    { do whatever you'd like to do with the files found }
    List.Add(Path + SearchRec.Name);
    FindResult := FindNext(SearchRec);
  end;
  { free memory }
  FindClose(SearchRec);
  if not IncludeSubDir then
    Exit;
  FindResult := FindFirst(Path + '*.*', faDirectory, SearchRec);
  while FindResult = 0 do
  begin
    if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
        FindFiles (Path + SearchRec.Name + '\', Mask, TRUE,List);
    FindResult := FindNext(SearchRec);
  end;
  { free memory }
  FindClose(SearchRec);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
liste:TStringList;
begin
    liste:=TStringList.Create;
    FindFiles(edit1.Text+'\','*.txt',False,liste);
    Memo1.Lines.Clear;
    Memo1.Lines:=Liste;
    liste.Free;
 end;

procedure TForm1.Button2Click(Sender: TObject);
var
 i:integer;
begin
  for i:= 0 to memo1.Lines.Count -1 do
      begin
        memo2.Lines.LoadFromFile(memo1.Lines[i]);
        memo3.Lines.Add(memo2.Text );
      end;
  memo3.Lines.SaveToFile(edit1.text+'\birlesmis.txt');
end;

end.

Tags: , ,

Delphi 7

Add comment




  Country flag
biuquote
  • Comment
  • Preview
Loading






Month List

Calendar

<<  December 2016  >>
MoTuWeThFrSaSu
2829301234
567891011
12131415161718
19202122232425
2627282930311
2345678

View posts in large calendar