2017年6月20日 星期二

Delphi POS 增強功能 : 最後位置,第 N 次位置,出現次數

http://delphi.ktop.com.tw/board.php/00_01_21/post.php?action=usereply&cid=31&fid=79&tid=28123&rid=183889&iid=2207


這只是很簡單的增強 POS 功能的 function ,不知有沒人 POST 過類似的    PosEnd 是回傳 SubStr 在 S 最後一次出現的位置,若沒出現回傳 0    PosN 是回傳 SubStr 在 S 第 n 次出現的位置,若出現少於n次回傳 0    PosCount 是回傳 SubStr 在 S 出現的次數    放這些 Function 的 Unit 要加 use StrUtils
function PosEnd(Substr,S: string): Integer;
var
  i : integer;
begin
  i := 0;
  repeat
    result := i;
    i := i   1;
    i := PosEx(SubStr,S,i)
  until i <= 0
end;    function PosN(Substr,S: string; N : Integer): Integer;
var
  i: integer;
begin
  result := 0;
  For i := 1 to N do
  begin
    result := result   1;
    result := PosEx(SubStr,S,result);
  end;
end;    function PosCount(SubStr,S : string) : Integer;
var
  i : integer;
begin
  i := 0;
  result := -1;
  repeat
    result := result   1;
    i := i   1;
    i := PosEx(SubStr,S,i)
  until i <= 0
end;
function PosEx(const SubStr, S: string; Offset: Cardinal = 1): Integer; 
var
  I,X: Integer;
  Len, LenSubStr: Integer;
begin
  if Offset = 1 then
    Result := Pos(SubStr, S)
  else
  begin
    I := Offset;
    LenSubStr := Length(SubStr);
    Len := Length(S) - LenSubStr   1;
    while I <= Len do
    begin
      if S[I] = SubStr[1] then
      begin
        X := 1;
        while (X < LenSubStr) and (S[I   X] = SubStr[X   1]) do
          Inc(X);
        if (X = LenSubStr) then
        begin
          Result := I;
          exit;
        end;
      end;
      Inc(I);
    end;
    Result := 0;
  end;
end;

Delphi Replace,InStr,Left,Right,LeftTrim,RightTrim,Reverse,Split,Replace,Mid Functions

https://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=382&lngWId=7




!**************************************
! Name: Replace,InStr,Left,Right,LeftTrim,RightTrim,Reverse,Split,Replace,Mid Functions
! Description:This is just like the name says, The Following Vb functions for Delphi all coded/translated by me:
RightTrim
LeftTrem
InStr
Mid
Left
Right
Replace
Split
Reverse
! By: telle (from psc cd)
!**************************************

unit Functions;
interface
uses
 Windows,Messages, SysUtils, Classes, Graphics,StdCtrls;
function RightTrim(const s:String):String;
function LeftTrim(const s:String):String;
function InStr(Start: integer; Source: string; SourceToFind: string): integer;
function Mid(Source: string; Start: integer; Length: integer): string;
function Left(Source: string; Length: integer): string;
function Right(Source: string; Lengths: integer): string;
function Replace(sData: String; sSubstring: String; sNewsubstring: string): String;
function Split(Source, Deli: string; StringList: TStringList): TStringList;
function Reverse(Line: string): string;
implementation
function Reverse(Line: string): string;
 var i: integer;
 var a: string;
begin
 For i := 1 To Length(Line) do
 begin
 a := Right(Line, i);
 Result := Result + Left(a, 1);
 end;
end;
function Split(Source, Deli: string; StringList: TStringList): TStringList;
var
 EndOfCurrentString: byte;
begin
 repeat
EndOfCurrentString := Pos(Deli, Source);
if EndOfCurrentString = 0 then
 StringList.add(Source)
else
 StringList.add(Copy(Source, 1, EndOfCurrentString - 1));
Source := Copy(Source, EndOfCurrentString + length(Deli), length(Source) - EndOfCurrentString);
 until EndOfCurrentString = 0;
 result := StringList;
end;
function Replace(sData: String; sSubstring: String; sNewsubstring: string): String;
var
i: integer;
lSub: Longint;
lData: Longint;
begin
i := 1;
lSub := Length(sSubstring);
lData := Length(sData);
repeat
begin
i := InStr(i, sData, sSubstring);
If i = 0 Then
begin
sNewSubString := sData;
Exit
end
Else
sData := Copy(sData, 1, i - 1) + sNewsubstring + Copy(sData, i + lSub, lData);
i := i + lSub;
End;
 Until i > lData;
Replace := sData;
end;
function Left(Source: string; Length: integer): string;
begin
 Result := copy(Source,1,Length);
end;
function Right(Source: string; Lengths: integer): string;
begin
Result := copy(source,Length(Source) - Lengths,Lengths);
end;
function Mid(Source: string; Start: integer; Length: integer): string;
begin
 Result := copy(Source,Start,Length);
end;
function InStr(Start: integer; Source: string; SourceToFind: string): integer;
begin
 Result := pos(SourceToFind,copy(Source,Start,Length(Source) - (Start - 1)));
end;
function RightTrim(const s:String):String;
var
i:integer;
begin
 i:=length(s);
 while (i>0) and (s[i]<=#32) do
Dec(i);
 result:=Copy(s,1,i);
end;
function LeftTrim(const s:String):String;
var
i, L:integer;
begin
 L:=length(s);
 i:=1;
 while (i<=L) and (s[i]<=#32) do
Inc(i);
 result:=Copy(s,i, MaxInt);
end;
end.

2017年6月12日 星期一

Robocopy 指定不複製特定目錄

Robocopy 指定不複製特定目錄

robocopy E:\Copy_Source E:\Copy_Dest /s /maxage:7  /e /XD *back* *111*

rem /maxage:7 只要這一周修改的文件

pause


http://blog.xuite.net/dragonfly_7252/computer/223236655-Robocopy+%E6%8C%87%E4%BB%A4%E7%AF%84%E4%BE%8B%E5%8F%83%E8%80%83+(MIR%E5%95%8F%E9%A1%8C%E5%BE%88%E5%A4%9A%EF%BC%8C%E5%B0%8F%E5%BF%83%E4%BD%BF%E7%94%A8


http://ithelp.ithome.com.tw/questions/10175518