7 нояб. 2013 г.

Перестановка колонок, выделение Ф.И.О из ФИО

Фокус еще в том, что исходный файл был DBF-ом, поэтому данные с 3 строки попадают в 1-ю в назначение (чтобы не трогать заголовки колонок)
Sub ConvertDBF()
    Sheets("DST").Columns("A:A").ColumnWidth = 3
    Sheets("DST").Columns("B:B").ColumnWidth = 5
    Sheets("DST").Columns("B:B").NumberFormat = "@"
    Sheets("DST").Columns("C:C").ColumnWidth = 5
    Sheets("DST").Columns("D:D").ColumnWidth = 6
    Sheets("DST").Columns("E:E").ColumnWidth = 8
    Sheets("DST").Columns("F:F").ColumnWidth = 23
    Sheets("DST").Columns("G:G").ColumnWidth = 23
    Sheets("DST").Columns("H:H").ColumnWidth = 23
    Sheets("DST").Columns("I:I").ColumnWidth = 21
    Sheets("DST").Columns("J:J").ColumnWidth = 12
    i = 3
    Do
        If Sheets("SRC").Cells(i, 5).Value = "" Then
            Exit Do
        End If
        Sheets("DST").Cells(i - 2, 1) = Sheets("SRC").Cells(i, 4)
        Sheets("DST").Cells(i - 2, 2) = "002"
        Sheets("DST").Cells(i - 2, 3) = "21"
        Sheets("DST").Cells(i - 2, 4) = Sheets("SRC").Cells(i, 6)
        Sheets("DST").Cells(i - 2, 5) = Sheets("SRC").Cells(i, 7)
        FIO = Trim(Sheets("SRC").Cells(i, 5))
        FirstSpacePos = InStr(1, FIO, " ", vbTextCompare)
        If FirstSpacePos > 0 Then
              Sheets("DST").Cells(i - 2, 6) = Left(FIO, FirstSpacePos - 1)
        End If
        SecondSpacePos = InStr(FirstSpacePos + 1, FIO, " ", vbTextCompare)
        If SecondSpacePos > 0 Then
              Sheets("DST").Cells(i - 2, 7) = Mid(FIO, FirstSpacePos + 1, SecondSpacePos - FirstSpacePos)
              Sheets("DST").Cells(i - 2, 8) = Mid(FIO, SecondSpacePos + 1)
        End If
        Sheets("DST").Cells(i - 2, 9) = Sheets("SRC").Cells(i, 14)
        Sheets("DST").Cells(i - 2, 10) = Sheets("SRC").Cells(i, 12)
    

        i = i + 1
    Loop
End Sub

2 сент. 2013 г.

Эвакуация автомобиля с Амуркабеля

Вот так теперь выглядит ГСК дяди Коли. Едва уговорили вывезти машину к нам.
Воды по край сапог. Пробираться можно только по краю.
В воде лежит шланг от помпы. Мы думали, что это они нам накачали. Нет. Это Красная речка к нам пришла. За гаражами речка вровень с двором ГСК.
Качают из канализации дома вдоль ул.Союзная (под 90 градусов к дому дяди Коли). Палатка стоит. В ней место для отдыха помпосмотрителя.
В подвале, видимо, полно воды, т.к. на улице сидели 2 белые кошки. Когда мы подошли - замяукали жалобно, но не убежали. Видимо, слегка одурели от того, что дома у них внезапно не стало. Машину своим ходом выгонять не рискнули, Никита вытащил Деликой. Пробег, кстати у нее меньше 1500 км - новая (но дверьми хлопать надо все равно сильно - автоВАЗ). А цвет ГИБДД определил как серо-сине-зеленый. Привет Люсе в алмазах!

1 авг. 2013 г.

Округление в выделенном диапазоне, Excel

Sub MyRoundRange()
    For Each cell In Selection
        cell.Value = WorksheetFunction.Round(cell.Value, 0)
    Next cell
End Sub

19 июн. 2013 г.

Вывод из Excel в файл

Любят бухгалтера все делать в Excel.А Диасофт 4х4 грузит из текстовых файлов.
Const BASE = 9000

Sub Макрос1()
    Dim fs, f
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.OpenTextFile("c:\clients.txt", 2, 8)

    i = 1
    Do
        If Cells(i, 1).Value = "" Then
            Exit Do
        End If
        f.WriteLine ("%КЛИЕНТ")
        f.WriteLine ("ИМЯ1      :" + Mid(Cells(i, 1).Value, 1, 40))
        f.WriteLine ("ИМЯ2      :" + Mid(Cells(i, 1).Value, 41, 40))
        f.WriteLine ("ИМЯ3      :" + Mid(Cells(i, 1).Value, 81, 40))
        f.WriteLine ("ИМЯ4      :" + Mid(Cells(i, 1).Value, 121, 40))
        f.WriteLine ("ТИП       :Ю")
        f.WriteLine ("АДРЕС1    :")
        f.WriteLine ("АДРЕС2    :")
        f.WriteLine ("ТЕЛЕФОН1  :")
        f.WriteLine ("ТЕЛЕФОН2  :")
        f.WriteLine ("КОД       :" + Trim(Str(i + BASE)))
        f.WriteLine ("ИНН       :" + Trim(Str(Cells(i, 2).Value)))
        f.WriteLine ("КПП       :" + Trim(Str(Cells(i, 3).Value)))
        f.WriteLine ("ГРУППА    :Юридические лица")
        f.WriteLine ("ДЕЙСТВИЕ  :Add")
        f.WriteLine ("%END")
        i = i + 1
    Loop
    f.Close
End

End Sub

5 июн. 2013 г.

ED206 - поиск внутри файла

Ищем внутри файлов слово ED206, те файлы, в которых находим, копируем в специально отведенное место.
grep -c "ED206" *.ED0| gawk "{print \"cp \"$1\" ED206/\"$1 }" |
 sed -e "/........\....:0/d" -e "s/\(........\....\)\(:1\)/\1/g"|
 cmd.exe

29 апр. 2013 г.

Открытие сезона. Мост на Уссурийский остров.

Открыл сезон, прокатив первые 50 километров, съездил к новому мосту. Моста еще нет, но опоры уже стоят. Постоянно по новой дороге ездит народ, интересуется. На указателе уже "Пограничный переход" - только речку надо перепрыгнуть.
Указатель в никуда

Дорога в никуда

Опоры моста

А тут был наплавной мост.

Excel из PHP

Есть система ведения распоряжений по курсам валют в обменниках. Обеспечивает ввод, печать, подтверждение курсов. Внезапно старшие товарищи решили нас осчастливить и обеспечить "автоматическую" загрузку курсов в Диасофт 5NT. Пришлось для получения требуемого к загрузке файла в формате MS Excel научиться изготавливать из CSV XLS.
 include_once "Spreadsheet/Excel/Writer.php";
 $xls =& new Spreadsheet_Excel_Writer();

 $name=$_GET['rasp'];
 $xls->send("KURS_".substr($name,0,3)."_".substr($name,7).".xls");
 $f = fopen($name, "rt") or die("Ошибка!");
 $sheet =& $xls->addWorksheet('Распоряжение');
 $format =& $xls->addFormat();
 $format->setColor("black");
 $dateFmt =& $xls->addFormat();
 $dateFmt->setColor("black");
 $dateFmt->setNumFormat("D MMMM,YYYY");
 $sheet->setColumn(0,5,20);
 for ($i=0; $data=fgetcsv($f,1000,","); $i++){
        $sheet->writeString(2, 0, "Филиал банка в г.Москве", $format);
        $sheet->writeString(4, 0, "Приказ № ".$data[0], $format);
        $sheet->writeString(6, 3, $data[2], $dateFmt);
        $sheet->writeString(12, 0, "Доллары США:", $format);
 $sheet->writeString(13, 0, "покупка -", $format);
 $sheet->writeString(13, 1, $data[3], $format);
 $sheet->writeString(13, 3, "продажа -", $format);
 $sheet->writeString(13, 4, $data[4], $format);
 $sheet->writeString(15, 0, "Евро:", $format);
 $sheet->writeString(16, 0, "покупка -", $format);
 $sheet->writeString(16, 1, $data[6], $format);
 $sheet->writeString(16, 3, "продажа -", $format);
 $sheet->writeString(16, 4, $data[7], $format);
 $sheet->writeString(18, 0, "Английские фунты стерлингов:", $format);
 $sheet->writeString(19, 0, "покупка -", $format);
 $sheet->writeString(19, 1, $data[9], $format);
 $sheet->writeString(19, 3, "продажа -", $format);
 $sheet->writeString(19, 4, $data[10], $format);
 $sheet->writeString(21, 0, "Швейцарские франки:", $format);
 $sheet->writeString(22, 0, "покупка -", $format);
 $sheet->writeString(22, 1, $data[12], $format);
 $sheet->writeString(22, 3, "продажа -", $format);
 $sheet->writeString(22, 4, $data[13], $format);
 $sheet->writeString(26, 1, "USD", $format);
 $sheet->writeString(26, 2, "EUR", $format);
 $sheet->writeString(26, 3, "GBP", $format);
 $sheet->writeString(26, 4, "CHF", $format);
 $sheet->writeString(27, 0, "USD", $format);
 $sheet->writeString(28, 0, "EUR", $format);
 $sheet->writeString(29, 0, "GBP", $format);
 $sheet->writeString(30, 0, "CHF", $format);
 $sheet->writeString(27, 1, "X", $format);
 $sheet->writeString(27, 2, $data[16], $format); //USD-EUR
 $sheet->writeString(27, 3, "0.00", $format);
 $sheet->writeString(27, 4, "0.00", $format);
 $sheet->writeString(28, 1, $data[15], $format); //EUR-USD
 $sheet->writeString(28, 2, "X", $format);
 $sheet->writeString(28, 3, "0.00", $format);
 $sheet->writeString(28, 4, "0.00", $format);
 $sheet->writeString(29, 1, "0.00", $format);
 $sheet->writeString(29, 2, "0.00", $format);
 $sheet->writeString(29, 3, "X", $format);
 $sheet->writeString(29, 4, "0.00", $format);
 $sheet->writeString(30, 1, "0.00", $format);
 $sheet->writeString(30, 2, "0.00", $format);
 $sheet->writeString(30, 3, "0.00", $format);
 $sheet->writeString(30, 4, "X", $format);
 $sheet->writeString(35, 0, $data[17], $format);
 $sheet->writeString(35, 3, $data[18], $format);
 $sheet->writeString(36, 0, $data[19], $format);
 $sheet =& $xls->addWorksheet('Приложение');
 $sheet->writeString(0,5,$data[2]);
 for($i=0;$i<3;$i++){
         $sheet->writeString($i+2,3,$data[1]); //time of the day
 }
 $sheet->writeString(2,5,"Ф-Л");
 $sheet->writeString(3,5,"ДО 1");
 $sheet->writeString(4,5,"ДО 2");

 }
        fclose($f);
 $xls->close();
 exit;

18 мар. 2013 г.

Загрузка в Диасофт FA# 5NT из 4х4 с поиском фамилий и счетов регэкспами

Программка берет из командной строки имя файла, в котором содержатся платежи в формате Диасофт 4х4. Загружает их, находит в назначении платежа с помощью регулярных выражений (библиотека Copyright (c) 1999-2004 Andrey V. Sorokin, St.Petersburg, Russia) ФИО, номер счета. Затем выгружает текстовые файлы, пригодные к загрузке в Диасофт FA# 5NT, в каталоги, необходимые для последующей загрузки.
Основное назначение - автоматизировать зачисление пришедших на физиков платежей с реквизитами счетов в назначении платежа.
unit SDIMAIN; 

interface 

uses Windows, Classes, Graphics, Forms, Controls, Menus, 
  Dialogs, StdCtrls, Buttons, ExtCtrls, ComCtrls, ImgList, StdActns, 
  ActnList, ToolWin, Grids, SysUtils, StrUtils, RegExpr; 

type 
  TMyGrid=class(TCustomGrid); 

  TSDIAppForm = class(TForm) 
    OpenDialog: TOpenDialog; 
    SaveDialog: TSaveDialog; 
    ToolBar1: TToolBar; 
    ToolButton1: TToolButton; 
    SaveButton: TToolButton; 
    ActionList1: TActionList; 
    FileNew1: TAction; 
    FileOpen1: TAction; 
    FileSave1: TAction; 
    FileSaveAs1: TAction; 
    FileExit1: TAction; 
    EditCut1: TEditCut; 
    EditCopy1: TEditCopy; 
    EditPaste1: TEditPaste; 
    HelpAbout1: TAction; 
    StatusBar: TStatusBar; 
    ImageList1: TImageList; 
    Panel1: TPanel; 
    StringGrid1: TStringGrid; 
    DelBtn: TBitBtn; 
    ToolButton3: TToolButton; 
    BtnSaveToCard: TBitBtn; 
    procedure BtnSaveToCardClick(Sender: TObject); 
  
    procedure DelBtnClick(Sender: TObject); 
    function  ToOEM(S:String):String; 
    function  ToAnsi(S:String):String; 
    function  LeftPad(S: string; Ch: Char; Len: Integer): string; 
    function  RightPad(S: string; Ch: Char; Len: Integer): string; 
    procedure LoadInFile(); 
    procedure FormShow(Sender: TObject); 
    procedure FileNew1Execute(Sender: TObject); 
    procedure FileOpen1Execute(Sender: TObject); 
    procedure FileSave1Execute(Sender: TObject); 
    procedure FileExit1Execute(Sender: TObject); 
    procedure DeleteARow(Grid: TStringGrid; ARow: Integer); 
  private 
    { Private declarations } 
  public 
    { Public declarations } 
  end; 

var 
  SDIAppForm: TSDIAppForm; 
  STag,Val: String; 
  SIn,SOut: String; 
  FamilyName,FirstName,SurName: String; 
  InFile,OutFile: TextFile; 
  TagLength:  Integer; 
  RegExp: TRegExpr; 
  Colwidths: array[0..6] of integer = (25,18,18,3,20,31,250); 
  // !!! This for 5NT File, don't touch 
implementation 


{$R *.dfm} 



procedure TSDIAppForm.DelBtnClick(Sender: TObject); 
begin 
  DeleteARow(StringGrid1, StringGrid1.Row); 
end; 

procedure TSDIAppForm.DeleteARow(Grid: TStringGrid;   ARow: Integer); 
begin 
  TMyGrid(Grid).DeleteRow(ARow); 
end; 

procedure TSDIAppForm.FileNew1Execute(Sender: TObject); 
begin 
  { Do nothing } 
end; 

procedure TSDIAppForm.FileOpen1Execute(Sender: TObject); 
begin 
  OpenDialog.Execute; 
  SDIAppForm.caption:='Зачисление переводов - '+ OpenDialog.Filename; 
  if OpenDialog.Filename<>'' then 
  begin 
    DelBtn.Enabled:=false; 
    SaveButton.Enabled:=false; 
    BtnSaveToCard.Enabled:=false; 
    LoadInFile; 
    if (StringGrid1.RowCount > 1) and (StringGrid1.Cells[6,1] <> '') then 
    begin 
      SaveButton.Enabled:=true; 
      BtnSaveToCard.Enabled:=true; 
      Delbtn.Enabled:=true; 
    end; 
  end; 
end; 

procedure TSDIAppForm.LoadInFile; 
var 
  col,row:Integer; 
begin 
  AssignFile(InFile,OpenDialog.Filename); 
  Reset(InFile); 
  StringGrid1.RowCount:=2; 
  row:=0; 
  for col := 0 to 6 do {clear second line} 
  begin 
       StringGrid1.Cells[col,1]:=''; 
  end; 
  while not Eof(InFile) do 
  begin 
    Readln(InFile, SIn); 
    SOut:=ToAnsi(SIn); 
    TagLength:=AnsiPos(':',SIn)-1; 
    if TagLength=-1 then 
    begin 
      STag:=SOut; 
    end 
    else 
    begin 
      STag:=MidStr(SOut,1,TagLength); 
      Val:=MidStr(SOut,TagLength+2,Length(SOut)-TagLength-1); 
    end; 
    if STag='%МЕЖБНКДОК' then 
    begin 
      row:=row+1; 
      if row>1 then 
          StringGrid1.RowCount:=row+1; 
    end; 
    if STag='ВАЛЮТА    ' then 
      StringGrid1.Cells[3,row]:=Val; 
    if STag='СУММА     ' then 
      StringGrid1.Cells[5,row]:=Val; 
    if (midstr(STag,1,4)='ПРИМ') and (length(Val)<>0) then 
      StringGrid1.Cells[6,row]:=StringGrid1.Cells[6,row]+Val; 
    if (midstr(STag,1,4)='%END') then 
    begin 
      try 
        RegExp := TRegExpr.Create; 
        RegExp.Expression := '[А-Я]{1}[а-я]{2,}\s[А-Я]{1}[а-я]{2,}\s[А-Я]{1}[а-я]{2,}'; 
        if RegExp.Exec(StringGrid1.Cells[6,row]) then 
        begin 
          RegExp.Expression := '[А-Я]{1}[А-Яа-я]{2,}'; 
          RegExp.Exec(RegExp.Match[0]); 
          StringGrid1.Cells[0,row]:=RegExp.Match[0]; 
          RegExp.ExecNext; 
          StringGrid1.Cells[1,row]:=RegExp.Match[0]; 
          RegExp.ExecNext; 
          StringGrid1.Cells[2,row]:=RegExp.Match[0]; 
        end; 
        RegExp.Expression := '(40817|42301|42302|42303|42304|42305|42306|42307)[0-9]{15}'; 
        if RegExp.Exec(StringGrid1.Cells[6,row]) then 
        begin 
          StringGrid1.Cells[4,row]:=RegExp.Match[0]; 
        end; 
     finally 
       RegExp.Free; 
     end; 
    end; 
  end; 
  CloseFile(InFile); 
end; 

procedure TSDIAppForm.FileSave1Execute(Sender: TObject); 
  var i,j:Integer; 
      S,Today:string; 
begin 
  Today:=DateTimeToStr(Now); 
  SaveDialog.FileName:='b'+Midstr(Today,9,2)+Midstr(Today,4,2)+Midstr(Today,1,2)+'a.777'; 
  SaveDialog.InitialDir:='c:\ObmenPC40\Dividend\'; 
  SaveDialog.Execute; 
  Rewrite(OutFile,SaveDialog.FileName); 
  for i := 1 to StringGrid1.RowCount - 1 do 
  begin 
      for j := 0 to StringGrid1.ColCount - 1 do 
      begin 
         S:=Trim(Midstr(StringGrid1.Cells[j,i],1,Colwidths[j])); 
         if Colwidths[j]>length(S) then 
            S:=LeftPad(S,' ',Colwidths[j]); 
         Write(OutFile,'  '+ToOEM(S));//!!! 

      end; 
      Write(OutFile,''#13+#10); 
  end; 
  Flush(OutFile); 
  CloseFile(OutFile); 

end; 

procedure TSDIAppForm.BtnSaveToCardClick(Sender: TObject); 
  var i,j:Integer; 
      Today:string; 
begin 
  Today:=DateTimeToStr(Now); 
  SaveDialog.FileName:='b'+Midstr(Today,9,2)+Midstr(Today,4,2)+Midstr(Today,1,2)+'a.777'; 
  SaveDialog.InitialDir:='c:\ObmenPC40\Card\'; 
  SaveDialog.Execute; 
  Rewrite(OutFile,SaveDialog.FileName); 
  for i := 1 to StringGrid1.RowCount - 1 do 
  begin 
      Write(OutFile,Trim(IntToStr(i))); 
      Write(OutFile,'^777'); 
      for j := 0 to StringGrid1.ColCount - 1 do 
      begin 
         Write(OutFile,'^'+ToOEM(Trim(StringGrid1.Cells[j,i])));//!!! 
      end; 
      Write(OutFile,''#13+#10); 
  end; 
  Flush(OutFile); 
  CloseFile(OutFile); 
end; 

procedure TSDIAppForm.FormShow(Sender: TObject); 
var 
   col: Integer; 
begin 
   StringGrid1.ColCount:=7; 
   StringGrid1.RowCount:=2; 
   StringGrid1.FixedRows:=1; 
   StringGrid1.ColWidths[0]:=90;   StringGrid1.Cells[0,0]:='Фамилия'; 
   StringGrid1.ColWidths[1]:=90;  StringGrid1.Cells[1,0]:='Имя'; 
   StringGrid1.ColWidths[2]:=90;   StringGrid1.Cells[2,0]:='Отчество'; 
   StringGrid1.ColWidths[3]:=20;   StringGrid1.Cells[3,0]:='Вал'; 
   StringGrid1.ColWidths[4]:=105;  StringGrid1.Cells[4,0]:='Номер счета'; 
   StringGrid1.ColWidths[5]:=70;   StringGrid1.Cells[5,0]:='Сумма'; 
   StringGrid1.ColWidths[6]:=1180;   StringGrid1.Cells[6,0]:='Примечание'; 
   for col := 0 to 6 do {clear second line} 
   begin 
       StringGrid1.Cells[col,1]:=''; 
   end; 
   DelBtn.Enabled:=false; 
   SaveButton.Enabled:=false; 
   BtnSaveToCard.Enabled:=false; 
   OpenDialog.FileName:= ParamStr(1); 
   SDIAppForm.Caption:='Зачисление переводов - '+ ParamStr(1); 
   if ParamStr(1) <> '' then 
   begin 
     LoadInFile; 
     if (StringGrid1.RowCount > 1) and (StringGrid1.Cells[6,1] <> '') then 
     begin 
       SaveButton.Enabled:=true; 
       BtnSaveToCard.Enabled:=true; 
       Delbtn.Enabled:=true; 
     end; 
   end; 
end; 

procedure TSDIAppForm.FileExit1Execute(Sender: TObject); 
begin 
  Close; 
end; 


function TSDIAppForm.ToOEM(S:String):String; 
{ ConvertAnsiToOem translates a string into the OEM-defined character set } 
{$IFNDEF WIN32} 
var 
  Source, Dest : array[0..255] of Char; 
{$ENDIF} 
begin 
  {$IFDEF WIN32} 
  SetLength(Result, Length(S)); 
  if Length(Result) > 0 then 
    AnsiToOem(PChar(S), PChar(Result)); 
  {$ELSE} 
  if Length(Result) > 0 then 
  begin 
    AnsiToOem(StrPCopy(Source, S), Dest); 
    Result := StrPas(Dest); 
  end; 
  {$ENDIF} 
end; { ConvertAnsiToOem } 

function TSDIAppForm.ToAnsi(S:String):String; 
{ ConvertOemToAnsi translates a string into the OEM-defined character set } 
{$IFNDEF WIN32} 
var 
  Source, Dest : array[0..255] of Char; 
{$ENDIF} 
begin 
  {$IFDEF WIN32} 
  SetLength(Result, Length(S)); 
  if Length(Result) > 0 then 
    OemToAnsi(PChar(S), PChar(Result)); 
  {$ELSE} 
  if Length(Result) > 0 then 
  begin 
    OemToAnsi(StrPCopy(Source, S), Dest); 
    Result := StrPas(Dest); 
  end; 
  {$ENDIF} 
end; { ConvertOemToAnsi } 

function TSDIAppForm.LeftPad(S: string; Ch: Char; Len: Integer): string; 
 var 
   RestLen: Integer; 
 begin 
   Result  := S; 
   RestLen := Len - Length(s); 
   if RestLen < 1 then Exit; 
   Result := S + StringOfChar(Ch, RestLen); 
 end; 

 function TSDIAppForm.RightPad(S: string; Ch: Char; Len: Integer): string; 
 var 
   RestLen: Integer; 
 begin 
   Result  := S; 
   RestLen := Len - Length(s); 
   if RestLen < 1 then Exit; 
   Result := StringOfChar(Ch, RestLen) + S; 
 end; 

end.

21 февр. 2013 г.

Создание VPN точка-точка на OpenVPN

Возникла необходимость сделать VPN точка-точка на W7. Решили сделать на OpenVPN. Сделали, теперь пишу, чтобы не забыть.
1. Качаем инсталляцию с сайта. Для Windows сборки на 64 и 32 разряда разные.
2. Инсталлируем. Не забываем поставить GUI.
3. Одну машину ставим в режим сервера, другую в режим клиента.
Та, что будет в режиме сервера - с фиксированным IP, за firewall-ом. В нем ковыряем дырочку, по не стандартному порту, чтобы затруднить сканирование.
Применять будем протокол UDP, по 2-м причинам:
- опять-таки сканировать труднее,
- производительность даже визуально живее. Проверялось при обращении к мапированному диску в винде, чтении с него аксессовской БД.
Сначала сделали c shared keys. Заработало быстро.
Делов собственно два:
- сгенерировать ключ и разложить на обе машины. Можно прямо в каталог config.
<pre>
openvpn --genkey --secret secret.key
</pre>
- написать конфиг, положить туда же.
Клиент:
<pre>
remote 195.1.2.3 1194
dev    tun
client
proto  udp
ifconfig 10.10.10.2 10.10.10.1
secret secret.key
keepalive 60 300
comp-lzo
verb 1
mute 20
log-append ../connect.log
status ../status
</pre>
Сервер:
<pre>
port  1194
dev   tun
udp-server
proto udp
ifconfig 10.10.10.1 10.10.10.2
secret secret.key
comp-lzo
verb 1
mute 20
log-append ../connect.log 
</pre>

Все, на значке гуя на сервере щелкаем "подключить", он становится желтым.
Будет желтым, пока кто-нибудь не подцепится. Тогда станет зеленым.
На клиенте, том кто вызывает, просто запускаем гуй, "подключить", смотрим какое все зеленое. На сертификатах все сложнее, однако только на первый взгляд. В виндовой инсталляции есть каталог easy-rsa, где лежат скрипты для генерации необходимой инфраструктуры открытых ключей.
Сначала переименовываем vars.bat и правим его. В принципе, достаточно одной правки - указать каталог ключей. Но! Необходимо в этот каталог скопировать файлы index.txt и serial, переименовав их. Если этого не сделать, то CA сгенерируется нормально, а вот ключи для работы не будут подписываться, будут оставаться только запросами на сертификаты, а не сертификатами.
Из запущенного сеанса cmd.exe запускаем последовательно vars.bat, затем командные файлы, которые генерируют dh, ключ и сертификат CA, затем ключи и сертификаты сервера и клиентов. Важно при генерации указывать разные DN для каждого клиента, если только специальной опцией не разрешить проглатывать одинаковые DN.
При каждой генерации образуется закрытый ключ (с расширением key) и сертификат (с расширением srt). Если получается другое расширение, значит открытый ключ у нас сгенерировался, но не подписался ключом CA и остался грязнулей запросом на сертификат.
Для работы вся эта куча ключей не нужна. На каждой машине кладется сертификат CA, чтобы проверять подлинность сертификатов, предъявляемых другой стороной, свой закрытый ключ, свой сертификат.
Соответственно, закрытый ключ CA прячем, т.к. он нужен для подписания новых ключей, а значит на рабочих машинах ему делать нечего, а лежать он будет в укромном месте.
Потом правим конфиги на работу с сертификатами, кладем ca.srt, client.srt, client.key (или srv.srt и srv.key) прямо в конфиг, чтобы не искать. Далее - все так же как и с shared keys - щелкаем мышкой по гую, соединяемся, отсоединяемся.
Клиент:
remote         195.239.178.94 11940
dev        tun
tls-client
proto        udp
ifconfig 10.10.10.2 10.10.10.1
dh        dh1024.pem
ca        ca.crt
cert        client.crt
key        client.key
keepalive 60 300
comp-lzo
verb 1
mute 20
log-append ../connect.log
status ../status

Сервер:
port        11940
dev        tun
tls-server
proto        udp
ifconfig 10.10.10.1 10.10.10.2
dh        dh1024.pem
ca        ca.crt
cert        server.crt
key        server.key
comp-lzo
verb 1
mute 20
log-append ../connect.log 
Еще не раскрыта тема длины ключей, отозванных сертификатов и маршрутизации.

18 февр. 2013 г.

Доработка файлов по 365-П (GUID, переименование, поиск ошибок и т.д.)


unit main; 

interface 

uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, StdCtrls, StrUtils, DateUtils, ComCtrls, ExtCtrls, ToolWin; 

type 
  TForm1 = class(TForm) 
    Go_Button:   TButton; 
    OpenDialog1: TOpenDialog; 
    OpenButton:  TButton; 
    SaveDialog1: TSaveDialog; 
    BtnRe: TButton; 
    ToolBar1: TToolBar; 
    Panel1: TPanel; 
    StatusBar1: TStatusBar; 
    ProgressBar1: TProgressBar; 
    SrcOpenDialog: TOpenDialog; 
    MProtocol: TRichEdit; 
    procedure FormCreate(Sender: TObject); 
    procedure BtnReClick(Sender: TObject); 
    procedure OpenButtonClick(Sender: TObject); 
    procedure Go_ButtonClick(Sender: TObject); 
    function  ToOEM(S:String):String; 
    function  ToAnsi(S:String):String; 
    function  WriteLog(Level:Integer; S:String):String; 
    function  FileSizeByName(Name:String): Integer; 
    function  isNum(const st:string): boolean; 

  private 
    { Private declarations } 
  public 
    { Public declarations } 
  end; 
const 
  OstPref='BOS1_'; 
  OstSrcPref='RBN'; 
  OperPref='BV100_'; 
  OperSrcPref='ZNO'; 
  NalschPref='BNS1_'; 
  NalschSrcPref='ZNO'; 
  ReceiptPref='PB1_'; 
  ChunkLimit=470000;    //524288 - 512К 
  Bic='10813823'; 
  INN='7744001497'; 
  ERR=0; 
  WARN=1; 
  INFO=2; 

var 
  Form1: TForm1; 
  InFile,OutFile: TextFile; 
  CurrentFileNum,NumOutFiles,OutFileSize: Integer; 
  SIn,SOut: String; 
  InFileSize, InFilePosition: Integer; 
  DateZapr,KodNO,NomZapr,NomResh,DateResh :String; 
  NumericTags: TStringList; 

implementation 

{$R *.dfm} 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
  DateZapr:=''; 
  NomZapr:=''; 
  NomResh:=''; 
  DateResh:=''; 
  NumericTags := TStringList.Create; 
  NumericTags.Add('ИННКО'); 
  NumericTags.Add('КППКО'); 
  NumericTags.Add('БИК'); 
  NumericTags.Add('ИНННП'); 
  NumericTags.Add('КППНП'); 
  NumericTags.Add('НомСчПП'); 
  NumericTags.Add('НомСч'); 
  NumericTags.Add('БИКБП'); 
  NumericTags.Add('НомКоррСч'); 
  NumericTags.Add('НомДок'); 
  NumericTags.Sort; //for Find method! 
end; 

procedure TForm1.OpenButtonClick(Sender: TObject); 
begin 
  OpenDialog1.execute; 
  DateZapr:=''; 
  NomZapr:=''; 
  NomResh:=''; 
  DateResh:=''; 
  MProtocol.Text:=''; 
  WriteLog(INFO,'Файл к обработке: '+OpenDialog1.Filename+''#13+#10); 
end; 

procedure TForm1.BtnReClick(Sender: TObject); 
var 
  FileName,DateStr: String; 
  NameLength: Integer; 
  Today: TDateTime; 
begin 
//Формирование подтерждения по заданному файлу 
//ZNO10813823_774820120203_000594### 
//10@@@ 
//2012-02-06@@@ 
//10:35:37@@@ 
//=== 
    if (AnsiPos('.',ExtractFileName(OpenDialog1.FileName))<>0) then 
      SaveDialog1.FileName:=ReceiptPref+MidStr(ExtractFileName(OpenDialog1.FileName),1,AnsiPos('.',ExtractFileName(OpenDialog1.FileName))-1)+'.TXT'
    else 
      SaveDialog1.FileName:=ReceiptPref+ExtractFileName(OpenDialog1.FileName)+'.TXT'; 
    SaveDialog1.Execute; 
    WriteLog(INFO,'Имя файла подтверждения: '+SaveDialog1.FileName+''#13+#10); 
    Rewrite(OutFile,SaveDialog1.FileName); 
    FileName:=ExtractFileName(OpenDialog1.FileName); 
    Writelog(INFO,''#13+#10); // empty line before receipt 
    Write(OutFile,MidStr(FileName,1,Length(FileName)-4)+'###'+''#13+#10); 
    WriteLog(INFO,MidStr(FileName,1,Length(FileName)-4)+'###'+''#13+#10); 
    Write(OutFile,'10@@@'+''#13+#10); 
    Writelog(INFO,'10@@@'+''#13+#10); 
    DateStr:=DateToStr(Now); 
    Write(OutFile,MidStr(DateStr,7,4)+'-'+MidStr(DateStr,4,2)+'-'+MidStr(DateStr,1,2)+'@@@'+''#13+#10); 
    Writelog(INFO,MidStr(DateStr,7,4)+'-'+MidStr(DateStr,4,2)+'-'+MidStr(DateStr,1,2)+'@@@'+''#13+#10); 
    Write(OutFile,TimeToStr(Now)+'@@@'+''#13+#10); 
    Writelog(INFO,TimeToStr(Now)+'@@@'+''#13+#10); 
    Write(OutFile,'==='+''#13+#10); 
    Writelog(INFO,'==='+''#13+#10); 
    Flush(OutFile); 
    CloseFile(OutFile); 
end; 

procedure TForm1.Go_ButtonClick(Sender: TObject); 
var 
  Id: TGUID; 
  StringNo, StringCount,Code: Integer; 
  Tag,Val,HeaderTag,HeaderVal,StrNo,StrFileNo,StrNumOutFiles,DateForName,NomForName, InfType, Pref:  String; 
  TagLength,HeaderTagLength,i:  Integer; 
  RetCode:Boolean; 
  TopHeader,ThirdHeader: Array of String; 
  TopHeaderLength,ThirdHeaderLength,HeaderState: Integer; 
  Index: Integer; 
begin 
  CurrentFileNum:=1; 
  OutFileSize:=0; 
  InFilePosition:=0; 
  MProtocol.Text:=''; 
  WriteLog(INFO,'Файл к обработке: '+OpenDialog1.Filename+''#13+#10); 
  if not (FileExists(OpenDialog1.Filename)) then  exit; 
  InFileSize:=FileSizeByName(OpenDialog1.Filename); 
  ProgressBar1.Min:=0; 
  ProgressBar1.Max:=InFileSize; 
  ProgressBar1.Position:=0; 
  AssignFile(InFile,OpenDialog1.Filename); 
//  Rewrite(OutFile, OpenDialog1.Filename+'.chk1'); 
  Rewrite(OutFile, OpenDialog1.Filename+'.chk'+Format('%.2d',[CurrentFileNum])); 
  Reset(InFile); 
  if InFileSize > ChunkLimit then 
  begin 
    WriteLog(WARN,'Размер файла больше предельного размера одной части'#13+#10); 
    NumOutFiles:=(InFileSize div ChunkLimit)+1; 
    Str(NumOutFiles,StrNumOutFiles); 
  end; 
  HeaderState:=0; 
  TopHeaderLength:=0; 
  ThirdHeaderLength:=0; 
  while not Eof(InFile) do 
  begin 
    Readln(InFile, SIn); 
    SOut:=ToAnsi(SIn); 
    if HeaderState < 3 then //Еще не считали все заголовки 
    begin 
      if HeaderState=0 then 
      begin //read top header 
        TopHeaderLength:=TopHeaderLength+1; 
        SetLength(TopHeader,TopHeaderLength); 
        TopHeader[TopHeaderLength-1]:=SOut; 
      end; 
      if HeaderState=2 then 
      begin //read 3rd header 
        ThirdHeaderLength:=ThirdHeaderLength+1; 
        SetLength(ThirdHeader,ThirdHeaderLength); 
        ThirdHeader[ThirdHeaderLength-1]:=SOut; 
      end; 
      if SOut='###' then HeaderState:=HeaderState+1; 
    end; 
    StringNo:=StringNo+1; 
    Str(StringNo,StrNo); 
    TagLength:=AnsiPos(':',SOut)-1; 
    if TagLength<>-1 then 
    begin 
      Tag:=MidStr(SOut,1,TagLength); 
      Val:=MidStr(SOut,TagLength+2,Length(SOut)-TagLength-1); 
      if (Tag = 'НомСч') and (HeaderState >=3) then // found new 3rd header when already read top 3 headers 
      begin 
        HeaderState:=2;   //return to 3rd header mode 
        ThirdHeaderLength:=1; //set 1st line of 3rd header 
        ThirdHeader[ThirdHeaderLength-1]:=SOut; // write it down 
        WriteLog(INFO,'Строка '+StrNo+' - Найдено:'+SOut); 
      end; 
      if Tag = 'ТипИнф' then 
      begin 
          InfType:=Val; 
          WriteLog(INFO,'Строка '+StrNo+' - Найден ТипИнф:'+InfType); 
      end; 
      if Tag = 'ИдФайл' then 
      begin 
          CreateGUID(Id); 
          SOut:='ИдФайл:'+ Val + MidStr(GUIDToString(Id),2,36); 
          WriteLog(INFO,'Строка '+StrNo+' - Добавлен GUID к ИдФайл'); 
      end; 
      if Tag = 'КодНО' then 
      begin 
          KodNO:=Val; 
          WriteLog(INFO,'Строка '+StrNo+' - Найден  КодНО:'+KodNO); 
      end; 
      if Tag = 'ИдДок' then 
      begin 
          CreateGUID(Id); 
          SOut:='ИдДок:'+ MidStr(GUIDToString(Id),2,36); 
          WriteLog(INFO,'Строка '+StrNo+' - добавлен GUID к ИдДок'); 
      end; 
      if (Tag = 'НомЧасти') and (InFileSize <= ChunkLimit) then 
      begin 
          SOut:=''; 
          WriteLog(INFO,'Строка '+StrNo+' - Удален НомЧасти'); 
      end; 
      if (Tag = 'КолДок') and (InFileSize > ChunkLimit) then 
      begin 
          SOut:='КолДок:'+StrNumOutFiles; 
          WriteLog(INFO,'Строка '+StrNo+' - КолДок исправлен'); 
      end; 
      if Tag = 'НомЗапр' then 
      begin 
        NomZapr:=''; 
        for i := length(Val) to 6 - 1 do   NomZapr:=NomZapr+'0'; 
          NomZapr:=NomZapr+Val; 
          WriteLog(INFO,'Строка '+StrNo+' - Найден НомЗапр:'+NomZapr); 
      end; 
      if Tag = 'ДатаЗапр' then 
      begin 
          DateZapr:=MidStr(Val,7,4)+MidStr(Val,4,2)+MidStr(Val,1,2); 
          WriteLog(INFO,'Строка '+StrNo+' - Найдена ДатаЗапр:'+DateZapr); 
      end; 
      if Tag = 'НомРеш' then 
      begin 
        NomResh:=''; 
        for i := length(Val) to 6 - 1 do   NomResh:=NomResh+'0'; 
          NomResh:=NomResh+Val; 
          WriteLog(INFO,'Строка '+StrNo+' - Найден НомРеш:'+NomResh); 
      end; 
      if Tag = 'ДатаРеш' then 
      begin 
          DateResh:=MidStr(Val,7,4)+MidStr(Val,4,2)+MidStr(Val,1,2); 
          WriteLog(INFO,'Строка '+StrNo+' - Найдена ДатаРеш:'+DateResh); 
      end; 
      if (NumericTags.Find(Tag,index)) then // Проверка корректности значений числовых тегов 
      begin 
          if not isNum(Val) then 
            WriteLog(ERR,'Строка '+StrNo+' - Ошибка: Не числовые значения:'+Tag+':'+Val); 
      end; 
      if (Val='') and (Tag<>'ИдДок') then // Только последним, после обработки других 
      begin 
          WriteLog(WARN,'Строка '+StrNo+' - Обнаружен пустой тег:'+Tag); 
      end; 
    end 
    else //No tags found! 
    begin 
      if (AnsiPos('Ошибка',SOut))<>0 then 
      begin 
          WriteLog(ERR,'Строка '+StrNo+' - Найдена ошибка: '+SOut); 
      end; 
      if (AnsiPos('Ожидается',SOut))<>0 then 
      begin 
          WriteLog(ERR,'Строка '+StrNo+' - Найдена ошибка: '+SOut); 
      end; 
    end; 
    if SOut<>'' then 
    begin 
      Writeln(OutFile,ToOEM(SOut)); 
      OutFileSize:=OutFileSize+Length(SOut); 
      InFilePosition:=InFilePosition+Length(SOut); 
      ProgressBar1.Position:=InFilePosition; 
      if  (OutFileSize > ChunkLimit) and (TagLength =-1) then 
      //достигли предела и не в середине документа 
      begin 
          Writeln(OutFile,'@@@'); 
          Writeln(OutFile,'==='); 
          OutFileSize:=0; 
          Flush(OutFile); 
          CloseFile(OutFile); 
          CurrentFileNum:=CurrentFileNum+1; 
          StrFileNo:=Format('%.2d',[CurrentFileNum]);  // for filename - with leading zero's 
          WriteLog(INFO,'Строка '+StrNo+' - Начало части '+StrFileNo); 
          Rewrite(OutFile, OpenDialog1.Filename+'.chk'+StrFileNo); 
          Str(CurrentFileNum,StrFileNo);              // for tag in the file - without leading zeros 
          for i:=0 to TopHeaderLength - 1 do 
          begin 
            HeaderTagLength:=AnsiPos(':',TopHeader[i])-1; 
            HeaderTag:=MidStr(TopHeader[i],1,HeaderTagLength); 
            HeaderVal:=MidStr(TopHeader[i],HeaderTagLength+2,Length(TopHeader[i])-HeaderTagLength-1); 
            if HeaderTag='ИдФайл' then 
              TopHeader[i]:='ИдФайл:'+ MidStr(HeaderVal,1,29) + MidStr(GUIDToString(Id),2,36); 
            if HeaderTag='НомЧасти' then 
              TopHeader[i]:='НомЧасти:'+ StrFileNo; 
            if HeaderTag='КолДок' then 
              TopHeader[i]:='КолДок:'+ StrNumOutFiles; 
            Writeln(OutFile,ToOEM(TopHeader[i])); 
          end; 
          Writeln(OutFile,ToOEM('@@@')); // добавить недостающие собаки после первого заголовка 
          for i:=0 to ThirdHeaderLength - 1 do 
            Writeln(OutFile,ToOEM(ThirdHeader[i])); 
      end; 
    end; 
  end; 
  Flush(OutFile); 
  CloseFile(OutFile); 
  SaveDialog1.FileName:=''; 
  if MessageDlg('Исходный запрос был получен электронно?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then 
  begin 
     SrcOpenDialog.Title:='Выберите файл исходного запроса'; 
     SrcOpenDialog.Execute(); 
     SaveDialog1.FileName:=MidStr(ExtractFileName(SrcOpenDialog.FileName),1,AnsiPos('.',ExtractFileName(SrcOpenDialog.FileName))-1); 
     if (InfType='ОСТАТКИ')      then Pref:=OstPref; 
     if (InfType='ОПЕРАЦИИПОСЧ') then Pref:=OperPref; 
     if (InfType='НАЛСЧЕТОВ')    then Pref:=NalschPref; 
     SaveDialog1.FileName:=Pref+SaveDialog1.FileName; 
  end 
  else // create name from file contents 
  begin 
     if (InfType='ОСТАТКИ')      then 
      SaveDialog1.FileName:=OstPref+OstSrcPref+Bic+'_'+KodNO+DateResh+'_'+NomResh; 
     if (InfType='ОПЕРАЦИИПОСЧ') then 
    SaveDialog1.FileName:=OperPref+OperSrcPref+Bic+'_'+KodNO; 
     if (InfType='НАЛСЧЕТОВ')  then 
    SaveDialog1.FileName:=NalschPref+NalschSrcPref+Bic+'_'+KodNO; 
     if ((InfType='ОПЕРАЦИИПОСЧ') or (InfType='НАЛСЧЕТОВ')) then 
    SaveDialog1.FileName:=SaveDialog1.FileName+DateZapr+'_'+NomZapr; 
  end; 
  SaveDialog1.FileName:=SaveDialog1.FileName+'.TXT'; 
  ProgressBar1.Position:=0; 
  if SaveDialog1.Execute then 
  begin 
    if NumOutFiles > 1 then 
    begin // больше чем один файл - нумеруем с "1" 
      for i := 1 to NumOutfiles do 
      begin 
//      Str(i,StrFileNo); 
        StrFileNo:=Format('%.2d',[i]); 
        RetCode:=RenameFile(OpenDialog1.Filename+'.chk'+StrFileNo, ReplaceStr(SaveDialog1.FileName,'BV100','BV1'+StrFileNo)); 
        if RetCode=false then 
          MessageDlg('Невозможно сохранить файл '+ReplaceStr(SaveDialog1.FileName,'BV100','BV1'+StrFileNo), mtError,[mbOk], 0, mbOk) 
        else 
          MessageDlg('Файл сохранен как: '+ReplaceStr(SaveDialog1.FileName,'BV100','BV1'+StrFileNo),mtInformation,[mbOk], 0, mbOk); 
      end; 
    end 
    else // один файл нумеруется с "0" 
    begin 
      StrFileNo:='01'; 
      RetCode:=RenameFile(OpenDialog1.Filename+'.chk'+StrFileNo,SaveDialog1.FileName); 
      if RetCode=false then 
        MessageDlg('Невозможно сохранить файл '+SaveDialog1.FileName, mtError,[mbOk], 0, mbOk) 
      else 
        MessageDlg('Файл сохранен как: '+SaveDialog1.FileName,mtInformation,[mbOk], 0, mbOk); 
    end; 
  end; 
end; 

function TForm1.WriteLog(Level:Integer; S:String):String; 
var 
  AColor:Integer; 
begin 
  case Level of 
    ERR : AColor := clRed; 
    INFO: AColor := clLime; 
    WARN: AColor := clYellow; 
  else 
    AColor := clLime; 
  end; 
  with MProtocol do 
   begin 
     SelStart := Length(Text); 
     SelAttributes.Color := AColor; 
     Lines.Add(S); 
   end; 
  MProtocol.SelStart := MaxInt; 
  SendMessage(MProtocol.handle, EM_SCROLLCARET,0,0); 
  Result:=S; 
end; 

function TForm1.ToOEM(S:String):String; 
{ ConvertAnsiToOem translates a string into the OEM-defined character set } 
{$IFNDEF WIN32} 
var 
  Source, Dest : array[0..255] of Char; 
{$ENDIF} 
begin 
  {$IFDEF WIN32} 
  SetLength(Result, Length(S)); 
  if Length(Result) > 0 then 
    AnsiToOem(PChar(S), PChar(Result)); 
  {$ELSE} 
  if Length(Result) > 0 then 
  begin 
    AnsiToOem(StrPCopy(Source, S), Dest); 
    Result := StrPas(Dest); 
  end; 
  {$ENDIF} 
end; { ConvertAnsiToOem } 

function TForm1.ToAnsi(S:String):String; 
{ ConvertOemToAnsi translates a string into the OEM-defined character set } 
{$IFNDEF WIN32} 
var 
  Source, Dest : array[0..255] of Char; 
{$ENDIF} 
begin 
  {$IFDEF WIN32} 
  SetLength(Result, Length(S)); 
  if Length(Result) > 0 then 
    OemToAnsi(PChar(S), PChar(Result)); 
  {$ELSE} 
  if Length(Result) > 0 then 
  begin 
    OemToAnsi(StrPCopy(Source, S), Dest); 
    Result := StrPas(Dest); 
  end; 
  {$ENDIF} 
end; { ConvertOemToAnsi } 

function  TForm1.FileSizeByName(Name:String): Integer; 
var 
  F: File of byte; 
begin 
  AssignFile(F, Name); 
  Reset(F); 
  Result:=FileSize(F); 
  CloseFile(F); 
end; 

function TForm1.isNum(const st:string): boolean; 
var 
  i: Integer; 
begin 
  isNum:=True; 
  for i := 1 to Length(st) do 
    if not (st[i] in ['0'..'9']) then isNum:=False; 
end; 

end.